7000 REM *********************************************************************
7005 REM ------------------------- ROUTINES.BAS ------------------------------
7010 REM
7015 REM updates - 08/15/90
7020 REM           10/16/90 added DATE and TIME
7025 REM                 added function keys to EDIT FIELD
7030 REM                 moved lines 6000-8000 to 16000 and up
7035 REM           11/23/90 added ENTER DOLLAR AMOUNT
7040 REM           12/27/90 added BAR GRAPH
7045 REM           12/29/90 added LARGE CHARACTER MESSAGES
7050 REM           01/02/91 added display window option to POINT & SHOOT MENU
7055 REM                 added ESCAPE to DELAY OR KEY
7060 REM           07/29/91 added inital item highlighted to POINT & SHOOT MENU
7065 REM           08/07/91 added WIN=2 to POINT & SHOOT MENU
7070 REM           11/04/91 removed WIN=0,1 and made TYP=0,1,2,3 instead
7075 REM                 on POINT & SHOOT MENU
7080 REM           01/03/92 moved MENUS, LARGE CHAR, BAR GRAPH, FILE SELECTION
7085 REM                 added TALL file selection
7090 REM           01/16/92 EDIT FIELD now re-prints edited string upon exit
7095 REM           05/18/92 changed entry/exit options to DATE and TIME
7100 REM           05/22/92 added preset colors to CHANGE COLORS
7105 REM                 added correct ESCAPE to POINT & SHOOT MENU
7110 REM           05/26/92 allow decimal point on numeric only EDIT STRING
7115 REM           05/28/92 fixed column calc on CENTER MESSAGE AND FIELD EDIT
7120 REM                 added TYP=3 (Y or N only) to EDIT FIELD
7125 REM                 changed FILE SELECT at 20000 to specify extension
7130 REM           10/29/92 removed leftover WIN variable from POINT AND SHOOT
7135 REM           12/28/92 added MULTIPLE SELECTION ON/OFF MENU
7140 REM           01/18/93 added SHADOW to all routines
7145 REM                 improved SELECT COLORS routines
7150 REM                 TYP changed to DISPTYPE and INPTYPE in some routines
7155 REM                 CENTER MESSAGE AND FIELD now has 4 display options
7160 REM                 ENTER TIME changed from 12500 to 13000
7165 REM                 ENTER DOLLAR AMOUNT now uses EDKEYS same as others
7170 REM                 ENTER DATE and ENTER TIME now uses EDKEYS
7175 REM                 POINT & SHOOT MENU highlighted ITEM now data colors
7180 REM                 added ROUTINTS.BAS to this file
7185 REM                 corrected 0 vs. 1 status in MULTIPLE SELECTION MENU
7190 REM           02/15/93 eliminated CENTER DOLLAR AMOUNT routine
7195 REM           eliminated "DATE" and "TIME" from date and time routines
7200 REM           changed MESSAGE AND FIELD to field/date/time/dollar and
7205 REM           moved from 9500 to 11000, moved MESSAGE from 9700 to 9500
7210 REM           moved 11000, 11100, 11200, 11500 (key and delay) to 19000's
7215 REM           added LEFT and RIGHT exits to DATE and TIME
7220 REM           added another MODE to DATE and TIME
7225 REM           better exit for FILE SELECTION at 20000
7230 REM           03/19/93 fixed file selection at 20000
7235 REM           10/26/93 added default colors, MESSAGE & FLD/DAT/TIM/$ edit
7240 REM                    fixed exits to DATE and TIME
7245 REM           01/11/94 fixed SELECT FILE NAME OF SPECIFIED EXT for DOS 6.x
7250 REM
7255 REM ----------------- BASIC ROUTINES FOR THE IBM PC ---------------------
7260 REM
7265 REM THIS IS A GROUP OF BASIC LANGUAGE SUBROUTINES WRITTEN
7270 REM FOR THE IBM PC AND COMPATIBLES. THESE SUBROUTINES WILL
7275 REM HELP THE BASIC PROGRAMMER SAVE TIME, WRITE MORE USER-
7280 REM FRIENDLY PROGRAMS, AND CREATE BETTER LOOKING DISPLAYS.
7285 REM
7290 REM THEY WERE DEVELOPED WITH THE SIMPLEST SYSTEM IN MIND,
7295 REM THAT IS, THEY USE FEW GRAPHICS OR SPECIAL COMMANDS, SO
7300 REM THEY WILL WORK ON A SYSTEM WITH A MONOCHROME MONITOR
7305 REM AS WELL AS MORE ADVANCED SYSTEMS. HOWEVER, WHEN USED
7310 REM WITH SYSTEMS THAT HAVE COLOR CAPABILITY, COLORS CAN
7315 REM BE SPECIFIED TO PRODUCE COLOR DISPLAYS.
7320 REM
7325 REM THESE SUBROUTINES ARE SUPPLIED WITH LINE NUMBERS AND
7330 REM WILL WORK WITH BASIC INTERPRETERS (LIKE BASICA.COM
7335 REM AND GWBASIC.EXE) AS WELL AS BASIC COMPILERS (LIKE
7340 REM QUICKBASIC AND TURBOBASIC). BOTH EXPERIENCED AND
7345 REM BEGINNING PROGRAMMERS WILL FIND USEFUL SUBROUTINES
7350 REM AND TECHNIQUES IN THIS SOURCE CODE.
7355 REM
7360 REM IN AN EFFORT TO MAKE THIS PACKAGE AS USEFUL AS POSSIBLE,
7365 REM IMPROVEMENTS TO THE EXISTING SUBROUTINES ARE OFTEN MADE
7370 REM AND NEW SUBROUTINES ARE ADDED. EVERY EFFORT IS MADE TO
7375 REM RETAIN COMPATIBILITY WITH THE PREVIOUS VERSIONS. WE
7380 REM WOULD ALSO LIKE TO SOLICIT YOUR SUGGESTIONS ON WAYS TO
7385 REM IMPROVE AND EXPAND THIS PACKAGE. PLEASE FEEL FREE TO
7390 REM CONTACT US AT THE ADDRESS LISTED ABOVE.
7395 REM
7400 REM                             NOTICE:
7405 REM
7410 REM ROUTINES.BAS IS NEITHER PUBLIC DOMAIN SOFTWARE NOR `SHAREWARE'.
7415 REM IT IS PROVIDED AS A SOURCE CODE PROGRAMMING TOOL TO A SINGLE
7420 REM USER SOLELY FOR INCLUSION IN PROGRAMS WRITTEN BY AND DISTRIBUTED 
7425 REM BY THE USER. DUPLICATION OF THIS SOFTWARE BY ANY MEANS IS LIMITED
7430 REM TO THIS INCLUSION AND TO COPIES MADE FOR BACKUP PURPOSES.
7435 REM
7440 REM                       WARNING - DISCLAIMER
7445 REM
7450 REM THIS SOFTWARE IS PROVIDE "AS IS" WITHOUT WARRANTY OF ANY KIND.
7455 REM THE ENTIRE RISK AS TO THE RESULT AND PERFORMANCE OF THIS SOFTWARE
7460 REM AS WELL AS ITS FITNESS FOR A PARTICULAR USE IS ASSUMED BY THE USER.
7465 REM NEITHER THE AUTHOR, NOR ANY PUBLISHER OR DISTRIBUTOR SHALL HAVE
7470 REM ANY LIABILITY FOR, NOR RESPONSIBILITY TO ANY PERSON OR ENTITY
7475 REM WITH RESPECT TO LOSS OR DAMAGE CAUSED OR ALLEGED TO BE CAUSED
7480 REM DIRECTLY OR INDIRECTLY BY THE SOFTWARE OR INFORMATION CONTAINED
7485 REM IN THIS PACKAGE.
7490 REM
7495 REM ------------------------- ROUTINES.BAS ------------------------------
7500 REM ----------------- BASIC ROUTINES FOR THE IBM PC ---------------------
7503 REM written by   GARY PEEK   3201 HIGHGATE   ST. CHARLES, MO   63301
7505 REM ---------- COPYRIGHT (c) 1989, 1990, 1991, 1992, 1993 ---------------
7510 REM
7515 REM
7520 REM                ROUTINES.BAS - QUICK REFERENCE
7525 REM
7530 REM
7535 REM                8000    display and select colors for ROUTINES
7540 REM
7545 REM                9000    outline the screen
7550 REM                9200    erase line
7555 REM
7560 REM                9500    display message at row and column
7565 REM
7570 REM                10000   edit a field at row and column
7575 REM                11000   message and field/date/time/dollar amount
7580 REM
7585 REM                12000   enter or change date
7590 REM                13000   enter or change time
7595 REM
7600 REM                15000   enter dollar amount
7605 REM
7610 REM                19000   wait for any key hit
7615 REM                19100   delay in seconds
7620 REM                19200   delay in seconds or key hit
7625 REM                19500   wait for a function key hit
7630 REM
7635 REM                20000   display and select file names (vertically)
7640 REM                21000   display and select file names (wide)
7645 REM
7650 REM                30000   point and shoot style menu
7655 REM                32000   multiple selection on/off menu
7660 REM
7665 REM                38000   full screen menu with work & prompt areas
7670 REM                38500   erase menu work area
7675 REM                38600   erase menu prompt area
7680 REM
7685 REM                50000   display a bar graph
7690 REM                51000   draw 1 bar for bar graph
7695 REM
7700 REM                60000   create messages with large characters
7705 REM                61000   display messages with large characters
7710 REM
7715 REM                The following require the assembly language interface
7720 REM
7725 REM                62000   GET MONITOR TYPE
7730 REM
7735 REM                The following provide access to mouse function calls
7740 REM
7745 REM                63000   hardware reset and status
7750 REM                63100   show cursor
7755 REM                63200   hide cursor
7760 REM                63300   get button status and mouse position
7765 REM                63400   set cursor position
7770 REM                63500   get button press info
7775 REM                63600   get button release info
7780 REM                63700   set cursor limits
7785 REM                63800   set graphics cursor
7790 REM                64000   set text cursor
7795 REM                64100   read motion counters
7800 REM                64600   set sensitivity and double speed
7805 REM                64900   get driver version, type, IRQ
7810 REM
7815 REM                65000   set up and call assembly language subroutine
7820 REM                65250   load assembly language subroutine
7825 REM
7830 REM *********************************************************************
7835 REM ------------------- DISPLAY AND SELECT COLORS -----------------------
7840 REM
7845 REM This routine will let you select 4 sets of colors to be used in some
7850 REM of the other routines for text, data, field, and shadow areas. If
7855 REM these color variables are not specified with this routine or are
7860 REM not specified elsewhere, the routines that use color will default
7865 REM to WHITE on BLACK for text, HIGH-INTENSITY WHITE on BLACK for data,
7870 REM BLACK on WHITE for fields, and GREY on BLACK for shadows. This will
7875 REM insure that the screen will display something that can be seen.
7880 REM
7885 REM TEXTFORE and TEXTBACK are text foreground and background colors
7890 REM These are the normal display colors
7895 REM DATAFORE and DATABACK are data foreground and background colors
7900 REM These are for data or other special things to highlight
7905 REM FIELDFORE and FIELDBACK are field foreground and background colors
7910 REM These are for fields used in editing or selecting data 
7915 REM SHADOWFORE and SHADOWBACK are shadow foreground and background colors
7920 REM These are for the optional box and shadow colors
7925 REM
7930 REM enter with -
7935 REM    TEXTFORE, TEXTBACK, DATAFORE, DATABACK,
7940 REM    FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK -
7945 REM    colors optionally specified for COLOR statements
7950 REM optional-
7955 REM    BOX=0,1,2,3 - type of outline around screen and example menu/box
7960 REM    0 = no box, 1 = 1 line box, 2 = 2 line box, 3 = solid box
7965 REM    (BOX should be set the same as the other routines that use BOX
7970 REM    in order to best see what the colors will look like.)
7975 REM exit with -
7980 REM    TEXTFORE, TEXTBACK, DATAFORE, DATABACK,
7985 REM    FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK -
7990 REM    BOX=0 (to maintain BOX as optional)
7995 REM
8000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                    :REM 8000
8005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15
8010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7
8015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8
8020 DIM COLOUR$(15):RESTORE 8585:REM POINT TO COLOR STRINGS
8025 FOR A%=0 TO 15:READ A$:COLOUR$(A%)=A$:NEXT A%
8030 COLORSET=0:DIM COLOURSET(30,8):RESTORE 8600:REM POINT TO COLOR SETS
8035 FOR A%=0 TO 24:FOR B%=1 TO 8:READ C%:COLOURSET(A%,B%)=C%:NEXT B%:NEXT A%
8040 REM -----
8045 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A%
8050 LOCATE ,,0:COLOR TEXTFORE,TEXTBACK:CLS
8055 IF BOX=0 THEN TP=0:BT=0:LS=0:RS=0:MS=0:MM=0:UL=0:LL=0:UR=0:LR=0:DN=0:RT=0
8060 IF BOX=1 THEN TP=196:BT=196:LS=195:RS=180:MS=179:MM=196:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195
8065 IF BOX=2 THEN TP=205:BT=205:LS=204:RS=185:MS=186:MM=205:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204
8070 IF BOX=3 THEN TP=223:BT=220:LS=219:RS=219:MS=219:MM=220:UL=219:LL=219:UR=219:LR=219
8075 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP));
8080 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT));
8085 COL=1:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW%
8090 COL=80:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW%
8095 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR);
8100 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR);
8105 REM -----
8110 MSG$=" CHANGE DISPLAY COLORS "
8115 ROW=4:COL=41-INT((LEN(MSG$)/2)):LOCATE ROW,COL:PRINT MSG$;
8120 LOCATE 22,3
8125 PRINT "F1=Text Color, F2=Text Background, F3=Highlite Color, F4=Highlite Background";
8130 LOCATE 23,3
8135 PRINT " F5=Field Color, F6=Field Background, F7=Shadow Color, F8=Shadow Background ";
8140 LOCATE 24,3
8145 PRINT "              F9=Preset Color Combinations, F10 or Enter=Exit               ";
8150 REM -----
8155 MAXITEM=4:MAXLEN=20
8160 ROW=11-INT((MAXITEM/2))
8165 COL=39-INT((MAXLEN/2))
8170 LOCATE ROW,COL:COLOR TEXTFORE,TEXTBACK
8175 PRINT CHR$(UL)+STRING$(MAXLEN+2,TP)+CHR$(UR);
8180 LOCATE ROW+1,COL:PRINT CHR$(MS)+" ";
8185 COLOR DATAFORE,DATABACK:PRINT "HIGHLITE/DATA colors";
8190 COLOR TEXTFORE,TEXTBACK:PRINT " "+CHR$(MS);
8195 LOCATE ROW+2,COL:COLOR TEXTFORE,TEXTBACK
8200 PRINT CHR$(LS)+STRING$(MAXLEN+2,MM)+CHR$(RS);
8205 LOCATE ROW+3,COL
8210 PRINT CHR$(MS)+" NORMAL TEXT colors   "+CHR$(MS);
8215 LOCATE ROW+4,COL
8220 PRINT CHR$(MS)+" NORMAL TEXT colors   "+CHR$(MS);
8225 LOCATE ROW+5,COL
8230 PRINT CHR$(MS)+" NORMAL TEXT colors   "+CHR$(MS);
8235 LOCATE ROW+6,COL:PRINT CHR$(MS)+" ";
8240 COLOR FIELDFORE,FIELDBACK:PRINT "FIELD/EDITING colors";
8245 COLOR TEXTFORE,TEXTBACK:PRINT " "+CHR$(MS);
8250 LOCATE ROW+7,COL
8255 PRINT CHR$(LL)+STRING$(MAXLEN+2,BT)+CHR$(LR);
8260 IF BOX=0 THEN 8350
8265 COLOR SHADOWFORE,SHADOWBACK
8270 LOCATE ROW+9,COL+8:PRINT " SHADOW colors ";:
8275 IF BOX=1 OR BOX=2 THEN 8310
8280 LOCATE ROW+8,COL+1:PRINT STRING$(MAXLEN+4,CHR$(TP));
8285 FOR DROW%=ROW+7 TO ROW+1 STEP -1
8290   LOCATE DROW%,COL+MAXLEN+4:PRINT CHR$(MS);
8295 NEXT DROW%
8300 LOCATE ROW,COL+MAXLEN+4:PRINT CHR$(BT);
8305 GOTO 8350
8310 LOCATE ROW+7,COL+2:PRINT CHR$(DN);:LOCATE ROW+8,COL+2:PRINT CHR$(LL);
8315 LOCATE ROW+8,COL+3:PRINT STRING$(MAXLEN+2,CHR$(BT));
8320 LOCATE ROW+8,COL+MAXLEN+5:PRINT CHR$(LR);
8325 FOR DROW%=ROW+6 TO ROW+1 STEP -1
8330   LOCATE DROW%+1,COL+MAXLEN+5:PRINT CHR$(MS);
8335 NEXT DROW%
8340 LOCATE ROW+1,COL+MAXLEN+3:PRINT CHR$(RT);CHR$(TP);CHR$(UR);
8345 REM -----
8350 IN$=INKEY$:IF IN$="" THEN 8350
8355 IF IN$=CHR$(0)+CHR$(59) THEN 8460
8360 IF IN$=CHR$(0)+CHR$(60) THEN 8475
8365 IF IN$=CHR$(0)+CHR$(61) THEN 8490
8370 IF IN$=CHR$(0)+CHR$(62) THEN 8505
8375 IF IN$=CHR$(0)+CHR$(63) THEN 8520
8380 IF IN$=CHR$(0)+CHR$(64) THEN 8535
8385 IF IN$=CHR$(0)+CHR$(65) THEN 8550
8390 IF IN$=CHR$(0)+CHR$(66) THEN 8565
8395 IF IN$=CHR$(0)+CHR$(67) THEN 8425
8400 IF IN$=CHR$(0)+CHR$(68) OR IN$=CHR$(13) THEN 8410
8405 BEEP:GOTO 8350
8410 COLOR TEXTFORE,TEXTBACK:BOX=0
8415 ERASE COLOUR$:ERASE COLOURSET:RETURN
8420 REM -----
8425 CSET=CSET+1:IF CSET>24 THEN CSET=0
8430 TEXTFORE=COLOURSET(CSET,1):TEXTBACK=COLOURSET(CSET,2)
8435 DATAFORE=COLOURSET(CSET,3):DATABACK=COLOURSET(CSET,4)
8440 FIELDFORE=COLOURSET(CSET,5):FIELDBACK=COLOURSET(CSET,6)
8445 SHADOWFORE=COLOURSET(CSET,7):SHADOWBACK=COLOURSET(CSET,8)
8450 IF BOX=1 OR BOX=2 THEN SHADOWFORE=TEXTFORE:SHADOWBACK=TEXTBACK
8455 GOTO 8050
8460 TEXTFORE=TEXTFORE+1:IF TEXTFORE>15 THEN TEXTFORE=0
8465 IF TEXTFORE=TEXTBACK THEN 8460
8470 GOTO 8050
8475 TEXTBACK=TEXTBACK+1:IF TEXTBACK>7 THEN TEXTBACK=0
8480 IF TEXTFORE=TEXTBACK THEN 8475
8485 GOTO 8050
8490 DATAFORE=DATAFORE+1:IF DATAFORE>15 THEN DATAFORE=0
8495 IF DATAFORE=DATABACK THEN 8490
8500 GOTO 8155
8505 DATABACK=DATABACK+1:IF DATABACK>7 THEN DATABACK=0
8510 IF DATAFORE=DATABACK THEN 8505
8515 GOTO 8155
8520 FIELDFORE=FIELDFORE+1:IF FIELDFORE>15 THEN FIELDFORE=0
8525 IF FIELDFORE=FIELDBACK THEN 8520
8530 GOTO 8155
8535 FIELDBACK=FIELDBACK+1:IF FIELDBACK>7 THEN FIELDBACK=0
8540 IF FIELDFORE=FIELDBACK THEN 8535
8545 GOTO 8155
8550 SHADOWFORE=SHADOWFORE+1:IF SHADOWFORE>15 THEN SHADOWFORE=0
8555 IF SHADOWFORE=SHADOWBACK THEN 8550
8560 GOTO 8155
8565 SHADOWBACK=SHADOWBACK+1:IF SHADOWBACK>7 THEN SHADOWBACK=0
8570 IF SHADOWFORE=SHADOWBACK THEN 8565
8575 GOTO 8155
8580 REM ------
8585 DATA "BLACK","BLUE","GREEN","CYAN","RED","MAGENTA","BROWN","WHITE"
8590 DATA "GREY","LIGHT BLUE","LIGHT GREEN","LIGHT CYAN","LIGHT RED"
8595 DATA "LIGHT MAGENTA","YELLOW","HIGH-INTENSITY WHITE"
8600 DATA 7,0,15,0,0,7,8,0
8605 DATA 7,1,15,1,15,4,0,1 
8610 DATA 10,1,11,1,15,2,0,1 
8615 DATA 11,1,14,1,15,4,0,1 
8620 DATA 12,1,11,1,15,0,0,1 
8625 DATA 15,1,12,1,15,5,5,1 
8630 DATA 0,3,15,3,15,0,8,3
8635 DATA 1,3,15,3,15,0,0,3 
8640 DATA 1,3,15,4,15,1,0,3
8645 DATA 10,3,14,5,14,5,5,3 
8650 DATA 14,3,1,3,14,0,0,3 
8655 DATA 15,3,0,3,14,0,0,3 
8660 DATA 0,4,14,4,15,4,14,4 
8665 DATA 15,4,14,4,14,0,14,4
8670 DATA 15,5,15,0,11,1,1,5 
8675 DATA 15,5,15,1,14,0,13,5 
8680 DATA 0,2,11,2,15,4,4,2 
8685 DATA 0,2,11,2,15,0,15,2 
8690 DATA 0,6,14,6,15,0,14,6 
8695 DATA 7,0,8,0,0,3,8,0 
8700 DATA 8,0,12,0,7,4,4,0 
8705 DATA 10,0,11,0,1,3,2,0 
8710 DATA 11,0,12,0,1,3,1,0 
8715 DATA 14,0,14,6,15,6,6,0 
8720 DATA 14,0,5,0,1,3,5,0 
8725 REM
8935 REM *********************************************************************
8940 REM --------------------- OUTLINE THE SCREEN ----------------------------
8945 REM
8950 REM This subroutines allows you to outline the screen with your
8955 REM choice of 4 types of boxes. Boxes 1, 2, and 3 are the same
8960 REM types of boxes used in other subroutines.
8965 REM
8970 REM enter with - BOX = 0,1,2,3 - type of box to outline the screen with
8975 REM              0=squares, 1=1 line box, 2=2 line box, 3=solid box
8980 REM optional -   TEXTFORE,TEXTBACK
8985 REM              colors optionally specified for COLOR statements
8990 REM exit with -  BOX=0 (to maintain BOX as optional for other routines)
8995 REM
9000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                    :REM 9000
9005 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A%
9010 LOCATE ,,0:COLOR TEXTFORE,TEXTBACK:CLS
9015 IF BOX=0 THEN TP=254:BT=254:MS=254:UL=254:LL=254:UR=254:LR=254
9020 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217
9025 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188
9030 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219
9035 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP));
9040 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT));
9045 COL=1:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW%
9050 COL=80:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW%
9055 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR);
9060 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR);
9065 BOX=0:RETURN
9070 REM
9075 REM
9145 REM *********************************************************************
9150 REM ------------------------- ERASE LINE --------------------------------
9155 REM
9160 REM This subroutine will erase the line of your choice from col. 2 to 79
9165 REM
9170 REM
9175 REM enter with - ROW=line to erase
9180 REM optional -   TEXTFORE,TEXTBACK
9185 REM              colors optionally specified for COLOR statements
9190 REM
9195 REM
9200 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                    :REM 9200
9205 COLOR TEXTFORE,TEXTBACK
9210 LOCATE ROW,2,0:PRINT SPACE$(78);
9215 RETURN
9220 REM
9405 REM *********************************************************************
9410 REM ------------------------- DISPLAY MESSAGE ---------------------------
9415 REM
9420 REM This subroutine allows you to display a message at a specified
9425 REM row and column or at the center of a specified row, and optionally
9430 REM draw a box with a shadow around it.
9435 REM
9440 REM enter with - MSG$="message", to display
9445 REM              ROW and COL=row and column on which to display "message"
9450 REM              (if COL=0 then message is centered)
9455 REM optional-    BOX=0,1,2,3 - type of box to draw around MSG$
9460 REM              0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid
9465 REM optional-    SHADOW=0,1 - type of shadow to include with box
9470 REM              0 = no shadow, 1 = shadow
9475 REM optional -   TEXTFORE, TEXTBACK, DATAFORE, DATABACK,
9480 REM              FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK
9485 REM              colors optionally specified for COLOR statements
9490 REM exit with -  BOX=0, SHADOW=0 (to maintain them as optional for later)
9495 REM
9500 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                    :REM 9500
9505 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8
9510 IF COL=0 THEN COL=41-INT((LEN(MSG$)/2))                                       :REM 9300
9515 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,COL,0:PRINT MSG$;:L=LEN(MSG$)
9520 IF BOX=0 THEN 9630
9525 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+LEN(MSG$):PRINT " ";
9530 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195
9535 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204
9540 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219
9545 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS);
9550 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+L+1:PRINT CHR$(UR);
9555 LOCATE ROW,COL+L+1:PRINT CHR$(MS);:LOCATE ROW+1,COL+L+1:PRINT CHR$(LR);
9560 LOCATE ROW-1,COL-1:PRINT STRING$(L+2,CHR$(TP));
9565 LOCATE ROW+1,COL-1:PRINT STRING$(L+2,CHR$(BT));
9570 IF SHADOW=0 THEN 9630
9575 COLOR SHADOWFORE,SHADOWBACK
9580 IF BOX<>1 AND BOX<>2 THEN 9615
9585 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL);
9590 LOCATE ROW+2,COL+1:PRINT STRING$(L+2,CHR$(BT));
9595 LOCATE ROW+2,COL+L+3:PRINT CHR$(LR);:LOCATE ROW+1,COL+L+3:PRINT CHR$(MS);
9600 LOCATE ROW,COL+L+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR);
9605 COLOR TEXTFORE,TEXTBACK:LOCATE ROW+1,COL+L+2:PRINT " ";
9610 GOTO 9630
9615 LOCATE ROW+2,COL-1:PRINT STRING$(L+4,CHR$(TP));
9620 LOCATE ROW+1,COL+L+2:PRINT CHR$(MS);:LOCATE ROW,COL+L+2:PRINT CHR$(MS);
9625 LOCATE ROW-1,COL+L+2:PRINT CHR$(BT);
9630 BOX=0:SHADOW=0:COLOR TEXTFORE,TEXTBACK
9635 RETURN
9640 REM
9820 REM *********************************************************************
9825 REM ---------------- EDIT A FIELD AT ROW AND COLUMN ---------------------
9830 REM
9835 REM This subroutine allows you to edit or enter a string. The editing
9840 REM keys perform the same functions as BASIC in the screen editing mode.
9845 REM
9850 REM enter with - ROW and COL=row and column at which to edit the string
9855 REM              LNG=maximum length of string allowed (up to 74)
9860 REM              (if LNG=0 then this routine just waits for any key hit)
9865 REM              TEMP$="string" to edit
9870 REM optional -   EDCOL=0, place cursor at beginning of string
9875 REM                    1, place cursor at end of string
9880 REM optional -   EDKEYS=0,1,2 - what keys allow you to exit the routine
9885 REM              0 = only ENTER or ESCAPE
9890 REM              1 = include PGUP, PGDN, UP, DOWN, LEFT, RIGHT ARROWS
9895 REM              2 = include F1-F10
9900 REM optional -   INPTYPE=0,1,2,3 - type of input desired
9905 REM              0 = normal ALPHANUMERIC
9910 REM              1 = ALPHANUMERIC with lower case changed to upper case
9915 REM              2 = NUMERIC only allowed
9920 REM              3 = Y or N only (or y or n changed to upper case)
9925 REM optional -   BOX=0,1,2,3 - type of box to draw around TEMP$
9930 REM              0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid
9935 REM optional-    SHADOW=0,1 - type of shadow to include with box
9940 REM              0 = no shadow, 1 = shadow
9945 REM optional -   TEXTFORE, TEXTBACK, DATAFORE, DATABACK
9950 REM              FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK
9955 REM              colors optionally specified for color statements
9960 REM exit with -  TEMP$="string" edited or entered
9965 REM              BOX=0,INPTYPE=0,EDKEYS=0,EDCOL=0 (to maintain as optional)
9970 REM              EXIT$=key hit that exited routine-
9975 REM              (EXIT$="ENTER" if field was completely filled)
9980 REM              "LEFT" if LEFT ARROW when at left side of field
9985 REM              "RIGHT" if RIGHT ARROW when at right side of field
9990 REM              "UP","DOWN","PGUP","PGDN","F1"-"F10","ENTER","ESC"
9995 REM
10000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                  :REM 10000
10005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15
10010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7
10015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8
10020 IF LNG=0 THEN LOCATE ,,0:GOTO 10215:REM WAIT FOR KEY ONLY
10025 LOCATE ,,0:INS=0:EXIT$="":TEMP$=LEFT$(TEMP$,LNG)
10030 IF EDCOL=0 THEN EDCOL=COL:GOTO 10040
10035 IF LEN(TEMP$)=LNG THEN EDCOL=COL+LEN(TEMP$)-1 ELSE EDCOL=COL+LEN(TEMP$)
10040 IF BOX=0 THEN 10170
10045 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195
10050 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204
10055 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219
10060 COLOR TEXTFORE,TEXTBACK
10065 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS);
10070 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+LNG+1:PRINT CHR$(UR);
10075 LOCATE ROW,COL+LNG+1:PRINT CHR$(MS);
10080 LOCATE ROW+1,COL+LNG+1:PRINT CHR$(LR);
10085 LOCATE ROW-1,COL-1:PRINT STRING$(LNG+2,CHR$(TP));
10090 LOCATE ROW+1,COL-1:PRINT STRING$(LNG+2,CHR$(BT));
10095 IF SHADOW=0 THEN 10165
10100 COLOR SHADOWFORE,SHADOWBACK
10105 IF BOX<>1 AND BOX<>2 THEN 10145
10110 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL);
10115 LOCATE ROW+2,COL+1:PRINT STRING$(LNG+2,CHR$(BT));
10120 LOCATE ROW+2,COL+LNG+3:PRINT CHR$(LR);
10125 LOCATE ROW+1,COL+LNG+3:PRINT CHR$(MS);
10130 LOCATE ROW,COL+LNG+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR);
10135 COLOR TEXTFORE,TEXTBACK:LOCATE ROW+1,COL+LNG+2:PRINT " ";
10140 GOTO 10165
10145 LOCATE ROW+2,COL-1:PRINT STRING$(LNG+4,CHR$(TP));
10150 LOCATE ROW+1,COL+LNG+2:PRINT CHR$(MS);
10155 LOCATE ROW,COL+LNG+2:PRINT CHR$(MS);
10160 LOCATE ROW-1,COL+LNG+2:PRINT CHR$(BT);
10165 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+LNG:PRINT " ";
10170 BOX=0:SHADOW=0
10175 LOCATE ROW,COL,0:COLOR FIELDFORE,FIELDBACK:PRINT TEMP$;
10180 LOCATE ROW,COL+LEN(TEMP$):PRINT SPACE$(LNG-LEN(TEMP$));
10185 L=LEN(TEMP$)
10190 AAAA$=MID$(TEMP$,EDCOL-COL+1,1)                      :REM --------------
10195 IF INS THEN LOCATE ROW,EDCOL:COLOR DATAFORE,DATABACK :REM    editing   |
10200 IF INS THEN PRINT AAAA$;:COLOR FIELDFORE,FIELDBACK   :REM     keys     |
10205 LOCATE ROW,EDCOL                                     :REM   available  |
10210 LOCATE,,1                                            :REM              |
10215 IN$=INKEY$:IF IN$="" THEN 10215                      :REM WAIT FOR KEY |
10220 IF LNG=0 THEN 10745                                  :REM ------------ |
10225 IF INPTYPE=3 THEN 10235                              :REM              |
10230 IF IN$=CHR$(13) THEN EXIT$="ENTER":GOTO 10710        :REM ENTER        |
10235 IF IN$=CHR$(27) THEN EXIT$="ESC":GOTO 10710          :REM ESCAPE       |
10240 IF IN$=CHR$(8) THEN 10520                            :REM BACKSPACE    |
10245 IF IN$=CHR$(0)+CHR$(71) THEN 10565                   :REM HOME         |
10250 IF IN$=CHR$(0)+CHR$(119) THEN 10575                  :REM CONTROL HOME |
10255 IF IN$=CHR$(0)+CHR$(75) THEN 10585                   :REM LEFT ARROW   |
10260 IF IN$=CHR$(0)+CHR$(77) THEN 10605                   :REM RIGHT ARROW  |
10265 IF IN$=CHR$(0)+CHR$(79) THEN 10645                   :REM END          |
10270 IF IN$=CHR$(0)+CHR$(117) THEN 10665                  :REM CONTROL END  |
10275 IF IN$=CHR$(0)+CHR$(82) THEN 10675                   :REM INSERT       |
10280 IF IN$=CHR$(0)+CHR$(83) THEN 10685                   :REM DELETE       |
10285 IF EDKEYS=0 THEN 10375                               :REM skip these - |
10290 IF IN$=CHR$(0)+CHR$(72) THEN EXIT$="UP":GOTO 10710   :REM UP ARROW     |
10295 IF IN$=CHR$(0)+CHR$(80) THEN EXIT$="DOWN":GOTO 10710 :REM DOWN ARROW   |
10300 IF IN$=CHR$(0)+CHR$(73) THEN EXIT$="PGUP":GOTO 10710 :REM PAGE UP      |
10305 IF IN$=CHR$(0)+CHR$(81) THEN EXIT$="PGDN":GOTO 10710 :REM PAGE DOWN    |
10310 REM                                                  :REM HOME         |
10315 REM                                                  :REM END          |
10320 IF EDKEYS=1 THEN 10375                               :REM skip these - |
10325 IF IN$=CHR$(0)+CHR$(59) THEN EXIT$="F1":GOTO 10710   :REM F1           |
10330 IF IN$=CHR$(0)+CHR$(60) THEN EXIT$="F2":GOTO 10710   :REM F2           |
10335 IF IN$=CHR$(0)+CHR$(61) THEN EXIT$="F3":GOTO 10710   :REM F3           |
10340 IF IN$=CHR$(0)+CHR$(62) THEN EXIT$="F4":GOTO 10710   :REM F4           |
10345 IF IN$=CHR$(0)+CHR$(63) THEN EXIT$="F5":GOTO 10710   :REM F5           |
10350 IF IN$=CHR$(0)+CHR$(64) THEN EXIT$="F6":GOTO 10710   :REM F6           |
10355 IF IN$=CHR$(0)+CHR$(65) THEN EXIT$="F7":GOTO 10710   :REM F7           |
10360 IF IN$=CHR$(0)+CHR$(66) THEN EXIT$="F8":GOTO 10710   :REM F8           |
10365 IF IN$=CHR$(0)+CHR$(67) THEN EXIT$="F9":GOTO 10710   :REM F9           |
10370 IF IN$=CHR$(0)+CHR$(68) THEN EXIT$="F10":GOTO 10710  :REM F10          |
10375 IF INPTYPE=0 OR INPTYPE=1 OR INPTYPE=3 THEN 10395    :REM --------------
10380 REM ----- allow only numbers or decimal point
10385 IF ASC(IN$)<46 OR ASC(IN$)>57 OR ASC(IN$)=47 THEN GOSUB 10760:GOTO 10210
10390 REM ----- allow only legitimate alphanumeric
10395 IF ASC(IN$)<32 OR ASC(IN$)>126 THEN GOSUB 10760:GOTO 10210
10400 REM ----- change to all upper case
10405 IF INPTYPE=0 OR INPTYPE=2 THEN 10435
10410 IF ASC(IN$)>=97 AND ASC(IN$)<=122 THEN IN$=CHR$(ASC(IN$)-32)
10415 REM ----- Yes or No only -----
10420 IF INPTYPE<>3 THEN 10435
10425 IF IN$<>"Y" AND IN$<>"N" THEN GOSUB 10760:GOTO 10210
10430 REM ----- good character
10435 L=EDCOL-COL:IF INS THEN 10480
10440 REM ----- add char. if at end of string
10445 IF EDCOL=COL+LEN(TEMP$) THEN TEMP$=TEMP$+IN$:GOTO 10495
10450 REM ----- add char. in middle if not in insert mode
10455 TEMP$=LEFT$(TEMP$,L)+IN$+RIGHT$(TEMP$,LEN(TEMP$)-1-L)
10460 REM ----- exit if overwriting last character
10465 IF EDCOL=COL+LNG-1 AND LEN(TEMP$)=LNG THEN EXIT$="ENTER":GOTO 10710
10470 GOTO 10495
10475 REM ----- in insert mode, check for full field
10480 IF LEN(TEMP$)=LNG THEN GOSUB 10760:GOTO 10175            :REM full field
10485 TEMP$=LEFT$(TEMP$,L)+IN$+RIGHT$(TEMP$,LEN(TEMP$)-L)      :REM not full
10490 REM ----- move cursor right if applicable
10495 IF EDCOL<COL+LNG-1 THEN EDCOL=EDCOL+1:GOTO 10175
10500 REM ----- exit if entering last character
10505 EXIT$="ENTER":GOTO 10710
10510 REM ----- BACKSPACE -----
10515 REM ----- error if at leftmost column
10520 IF EDCOL=COL THEN GOSUB 10760:GOTO 10175
10525 REM ----- skip moving cursor left if the field is full
10530 IF LEN(TEMP$)=LNG AND EDCOL=COL+LNG-1 THEN 10555
10535 REM ----- normal backspace (in middle of field)
10540 L=EDCOL-1-COL:TEMP$=LEFT$(TEMP$,L)+RIGHT$(TEMP$,LEN(TEMP$)-1-L)
10545 EDCOL=EDCOL-1:GOTO 10175
10550 REM ----- backspace if at rightmost column
10555 TEMP$=LEFT$(TEMP$,LEN(TEMP$)-1):GOTO 10175
10560 REM ----- HOME -----
10565 INS=0:EDCOL=COL:GOTO 10175
10570 REM ----- CONTROL HOME -----
10575 INS=0:TEMP$="":EDCOL=COL:GOTO 10175
10580 REM ----- LEFT ARROW -----
10585 INS=0:IF EDCOL>COL THEN EDCOL=EDCOL-1:GOTO 10175
10590 IF EDKEYS=0 THEN GOSUB 10760:GOTO 10175           :REM error if left col
10595 EXIT$="LEFT":GOTO 10710                           :REM or exit
10600 REM ----- RIGHT ARROW -----
10605 INS=0:IF EDCOL<COL+LNG-1 THEN 10625
10610 IF EDKEYS=0 THEN GOSUB 10760:GOTO 10175          :REM error if right col
10615 EXIT$="RIGHT":GOTO 10710                         :REM or exit
10620 REM ----- move cursor right if applicable
10625 IF EDCOL<COL+LEN(TEMP$) THEN EDCOL=EDCOL+1:GOTO 10175
10630 REM add "blank" character when cursor is moved to right
10635 TEMP$=TEMP$+CHR$(255):EDCOL=EDCOL+1:GOTO 10175
10640 REM ----- END -----
10645 INS=0:IF LEN(TEMP$)=LNG THEN EDCOL=COL+LEN(TEMP$)-1:GOTO 10175
10650 EDCOL=COL+LEN(TEMP$):GOTO 10175
10655 REM:END:IF EDCOL>COL+LNG THEN EDCOL=COL+LNG:GOTO 10025
10660 REM ----- CONTROL END -----
10665 INS=0:TEMP$=LEFT$(TEMP$,EDCOL-COL):GOTO 10175
10670 REM ----- INSERT -----
10675 IF INS THEN INS=0:GOTO 10175 ELSE INS=-1:GOTO 10175
10680 REM ----- DELETE -----
10685 INS=0:L=EDCOL-COL
10690 REM:IF EDCOL=COL+LNG-1 THEN GOSUB 10515:GOTO 10025:REM needed?
10695 IF EDCOL>=COL+LEN(TEMP$) THEN GOSUB 10760:GOTO 10175
10700 TEMP$=LEFT$(TEMP$,L)+RIGHT$(TEMP$,LEN(TEMP$)-L-1):GOTO 10175
10705 REM ----- COMMON EXIT -----
10710 BLANK$=CHR$(255):REM remove blanks at end
10715 IF RIGHT$(TEMP$,1)=BLANK$ THEN TEMP$=LEFT$(TEMP$,LEN(TEMP$)-1):GOTO 10715
10720 FOR A%=1 TO LEN(TEMP$):REM change blanks in middle to spaces
10725   IF MID$(TEMP$,A%,1)=CHR$(255) THEN MID$(TEMP$,A%,1)=" "
10730 NEXT A%
10735 LOCATE ROW,COL,0:COLOR TEXTFORE,TEXTBACK
10740 PRINT TEMP$+SPACE$(LNG-LEN(TEMP$));
10745 BOX=0:INPTYPE=0:EDKEYS=0:EDCOL=0:RETURN
10750 REM
10755 REM ----- BEEP IF ERROR -----
10760 BEEP:RETURN
10765 REM
10770 REM
10810 REM *********************************************************************
10815 REM ------------- MESSAGE AND FIELD/DATE/TIME/DOLLAR AMOUNT -------------
10820 REM
10825 REM This subroutine allows you to combine a message along with a field
10830 REM entry or edit, date or time entry, or dollar amount entry, while
10835 REM making adjustments for optional centering and boxes.
10840 REM
10845 REM enter with - MSG$="message" to display and,
10850 REM              everything required or optionally required with the
10855 REM              EDIT A FIELD AT ROW AND COLUMN routine, or
10860 REM              ENTER DATE routine, or ENTER TIME routine, or
10865 REM              ENTER DOLLAR AMOUNT routine
10870 REM              (except COL when centering is selected.)
10875 REM optional-    BOX=0,1,2,3 - type of box to draw around MSG$
10880 REM              0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid
10885 REM optional-    SHADOW=0,1 - type of shadow to include with box
10890 REM              0 = no shadow, 1 = shadow
10895 REM optional -   FLDTYPE = 0, 1, 2 or 3 - type of field/entry
10900 REM              0 = enter or edit field
10905 REM              1 = date
10910 REM              2 = time
10915 REM              3 = dollar amount
10920 REM optional -   ORTYPE = 0, 1, 2 or 3 - type of message/field orientation
10925 REM              0 = side by side and centered in ROW (COL not required)
10930 REM              1 = side by side at ROW and COL
10935 REM              2 = field below message and centered in ROW (COL not required)
10940 REM              3 = field below message at ROW and COL
10945 REM              (if a box is specified the field will be 2 rows below
10950 REM              the message, otherwise it will be 1 row below)
10955 REM optional -   DISPTYPE=0 or 1 - type of display desired
10960 REM              0 = normal message
10965 REM              1 = message with screen restored
10970 REM exit with -  everything returned with
10975 REM              FIELD, DATE, TIME, or DOLLAR AMOUNT routine,
10980 REM              BOX=0, SHADOW=0, ORTYPE=0, FLDTYPE=0, DISPTYPE=0
10985 REM              (to maintain as optional)
10990 REM
10995 REM                                                           :REM 11000
11000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7
11005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15
11010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7
11015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8
11020 REM
11025 IF FLDTYPE=1 OR FLDTYPE=2 THEN LNG=8                   :REM DATE OR TIME
11030 IF ORTYPE=0 OR ORTYPE=1 THEN MAXLEN=LEN(MSG$)+1+LNG:GOTO 11040  :REM SxS
11035 IF LEN(MSG$)>LNG THEN MAXLEN=LEN(MSG$) ELSE MAXLEN=LNG          :REM TxB
11040 IF ORTYPE=0 OR ORTYPE=2 THEN COL=41-(INT(MAXLEN/2))        :REM CENTERED
11045 REM
11050 IF BOX<>0 THEN 11075
11055 STARTCOL=COL-1:ENDCOL=COL+MAXLEN                              :REM BOX=0
11060 IF ORTYPE=0 OR ORTYPE=1 THEN STARTROW=ROW:ENDROW=ROW            :REM SxS
11065 IF ORTYPE=2 OR ORTYPE=3 THEN STARTROW=ROW:ENDROW=ROW+1          :REM TxB
11070 GOTO 11100
11075 STARTCOL=COL-2:ENDCOL=COL+MAXLEN+2                           :REM BOX<>0
11080 IF ORTYPE=0 OR ORTYPE=1 THEN STARTROW=ROW-1:ENDROW=ROW+1        :REM SxS
11085 IF ORTYPE=2 OR ORTYPE=3 THEN STARTROW=ROW-1:ENDROW=ROW+3        :REM TxB
11090 REM
11095 REM ----- SAVE SCREEN IF REQUIRED
11100 IF DISPTYPE<>1 THEN 11180
11105 SHADOFF=0
11110 IF SHADOW<>0 AND BOX=3 THEN SHADOFF=1 
11115 IF SHADOW<>0 AND (BOX=1 OR BOX=2) THEN SHADOFF=2 
11120 DIM MSGSSCHR(ENDROW-STARTROW+1+SHADOFF,ENDCOL-STARTCOL+1+SHADOFF)
11125 DIM MSGSSCOLOR(ENDROW-STARTROW+1+SHADOFF,ENDCOL-STARTCOL+1+SHADOFF,2)
11130 R=1:C=1
11135 FOR SR%=STARTROW TO ENDROW+SHADOFF
11140   FOR SC%=STARTCOL TO ENDCOL+SHADOFF
11145     MSGSSCHR(R,C)=SCREEN(SR%,SC%,0)
11150     A=SCREEN(SR%,SC%,1):MSGSSCOLOR(R,C,1)=(A AND 15)
11155     IF (A AND 128)=128 THEN MSGSSCOLOR(R,C,1)=MSGSSCOLOR(R,C,1)+16
11160     MSGSSCOLOR(R,C,2)=(A AND 112)/16
11165   C=C+1:NEXT SC%
11170 R=R+1:C=1:NEXT SR%
11175 REM -----
11180 IF BOX=0 THEN 11360
11185 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:LF=195:RT=180
11190 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:LF=204:RT=185
11195 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219:DN=219:LF=219:RT=219
11200 COLOR TEXTFORE,TEXTBACK                                         :REM BOX
11205 LOCATE ROW-1,COL-2:PRINT CHR$(UL)+STRING$(MAXLEN+2,CHR$(TP))+CHR$(UR);
11210 LOCATE ROW,COL-2:PRINT CHR$(MS)+SPACE$(MAXLEN+2)+CHR$(MS);
11215 LOCATE ROW+1,COL-2:PRINT CHR$(LL)+STRING$(MAXLEN+2,CHR$(BT))+CHR$(LR);
11220 IF ORTYPE=0 OR ORTYPE=1 THEN 11245
11225 LOCATE ROW+1,COL-2:PRINT CHR$(LF);                        :REM LOWER BOX
11230 LOCATE ROW+1,COL+MAXLEN+1:PRINT CHR$(RT);
11235 LOCATE ROW+2,COL-2:PRINT CHR$(MS)+SPACE$(MAXLEN+2)+CHR$(MS);
11240 LOCATE ROW+3,COL-2:PRINT CHR$(LL)+STRING$(MAXLEN+2,CHR$(BT))+CHR$(LR);
11245 IF SHADOW=0 THEN 11360
11250 COLOR SHADOWFORE,SHADOWBACK                                  :REM SHADOW
11255 IF ORTYPE=0 OR ORTYPE=1 THEN ROWOFF=0 ELSE ROWOFF=2
11260 IF BOX<>1 AND BOX<>2 THEN 11330
11265 LOCATE ROW+1+ROWOFF,COL:PRINT CHR$(DN);              :REM BOX 1,2 SHADOW
11270 LOCATE ROW+2+ROWOFF,COL:PRINT CHR$(LL);
11275 LOCATE ROW+2+ROWOFF,COL+1:PRINT STRING$(MAXLEN+2,CHR$(BT));
11280 LOCATE ROW+2+ROWOFF,COL+MAXLEN+3:PRINT CHR$(LR);
11285 FOR DROW=ROW+1 TO ROW+1+ROWOFF
11290   LOCATE DROW,COL+MAXLEN+3:PRINT CHR$(MS);
11295 NEXT DROW
11300 LOCATE ROW,COL+MAXLEN+1:PRINT CHR$(LF);CHR$(TP);CHR$(UR);
11305 COLOR TEXTFORE,TEXTBACK
11310 FOR DROW=ROW+1 TO ROW+1+ROWOFF
11315   LOCATE DROW,COL+MAXLEN+2:PRINT " ";
11320 NEXT DROW
11325 GOTO 11360
11330 LOCATE ROW+2+ROWOFF,COL-1:PRINT STRING$(MAXLEN+4,CHR$(TP));:REM BOX3SHAD
11335 FOR DROW=ROW+1+ROWOFF TO ROW STEP-1
11340   LOCATE DROW,COL+MAXLEN+2:PRINT CHR$(MS);
11345 NEXT DROW
11350 LOCATE ROW-1,COL+MAXLEN+2:PRINT CHR$(BT);
11355 REM -----
11360 COLOR TEXTFORE,TEXTBACK                                     :REM MESSAGE
11365 IF ORTYPE=2 OR ORTYPE=3 THEN 11385
11370 LOCATE ROW,COL-1:PRINT " "+MSG$+" "+SPACE$(LNG+1);              :REM SxS
11375 COL=COL+1+LEN(MSG$):GOTO 11405
11380 REM
11385 LOCATE ROW,COL-1:PRINT " "+MSG$+" ";                            :REM TxB
11390 IF BOX=0 THEN ROW=ROW+1 ELSE ROW=ROW+2 
11395 LOCATE ROW,COL-1:PRINT SPACE$(LNG+2)
11400 REM
11405 BOX=0:SHADOW=0                                                :REM FIELD
11410 IF FLDTYPE=0 THEN GOSUB 10000:REM edit field        SUBROUTINE USED HERE
11415 IF FLDTYPE=1 THEN GOSUB 12000:REM enter date        SUBROUTINE USED HERE
11420 IF FLDTYPE=2 THEN GOSUB 13000:REM enter time        SUBROUTINE USED HERE
11425 IF FLDTYPE=3 THEN GOSUB 15000:REM enter $ amount    SUBROUTINE USED HERE
11430 REM
11435 REM ----- RESTORE SCREEN IF REQUIRED
11440 IF DISPTYPE<>1 THEN 11490
11445 R=1:C=1
11450 FOR SR%=STARTROW TO ENDROW+SHADOFF
11455   FOR SC%=STARTCOL TO ENDCOL+SHADOFF
11460     COLOR MSGSSCOLOR(R,C,1),MSGSSCOLOR(R,C,2)
11465     LOCATE SR%,SC%:PRINT CHR$(MSGSSCHR(R,C));
11470     C=C+1:NEXT SC%
11475   R=R+1:C=1:NEXT SR%
11480 ERASE MSGSSCHR:ERASE MSGSSCOLOR
11485 REM -----
11490 BOX=0:SHADOW=0:ORTYPE=0:FLDTYPE=0:DISPTYPE=0
11495 RETURN
11860 REM ********************************************************************
11865 REM ------------------------- ENTER DATE -------------------------------
11870 REM
11875 REM This routine lets you to enter the date in the format DD/MM/YY or
11880 REM optionally set the DOS date.
11885 REM
11890 REM enter with - ROW and COL=row and column at which to begin the prompt
11895 REM              (COL=35 for centered prompt)
11900 REM              MODE=0,1,2 - type of entry
11905 REM              0 = TEMP$ is initial date and entered date
11910 REM              1 = start with current date, TEMP$ = entered date
11915 REM              2 = start with current date, TEMP$ = entered date
11920 REM              and DOS date is set
11925 REM optional -   TEMP$="MM/DD/YY" - initial date
11930 REM optional -   EDKEYS=0,1,2 - what keys allow you to exit the routine
11935 REM              0 = only ENTER or ESCAPE
11940 REM              1 = include PGUP, PGDN, UP, DOWN, LEFT, RIGHT
11945 REM              2 = include F1-F10
11950 REM optional -   BOX=0,1,2,3 - type of box to draw around prompt
11955 REM              0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid
11960 REM optional-    SHADOW=0,1 - type of shadow to include with box
11965 REM              0 = no shadow, 1 = shadow
11970 REM optional -   TEXTFORE, TEXTBACK, DATAFORE, DATABACK
11975 REM              FIELDFORE,FIELDBACK, SHADOWFORE, SHADOWBACK
11980 REM              colors optionally specified for COLOR statements
11985 REM exit with -  TEMP$="DD/MM/YY" (and DOS date set if MODE=2)
11990 REM              BOX=0, SHADOW=0, EDKEYS=0, MODE=0 (to maintain as opt.)
11995 REM
12000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                  :REM 12000
12005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15
12010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7
12015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8
12020 IF BOX=0 THEN 12135
12025 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195
12030 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204
12035 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219
12040 COLOR TEXTFORE,TEXTBACK
12045 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS);
12050 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+14:PRINT CHR$(UR);
12055 LOCATE ROW,COL+14:PRINT CHR$(MS);
12060 LOCATE ROW+1,COL+14:PRINT CHR$(LR);
12065 LOCATE ROW-1,COL-1:PRINT STRING$(15,CHR$(TP));
12070 LOCATE ROW+1,COL-1:PRINT STRING$(15,CHR$(BT));
12075 IF SHADOW=0 THEN 12135
12080 L=8:COLOR SHADOWFORE,SHADOWBACK
12085 IF BOX<>1 AND BOX<>2 THEN 12120
12090 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL);
12095 LOCATE ROW+2,COL+1:PRINT STRING$(L+2,CHR$(BT));
12100 LOCATE ROW+2,COL+L+3:PRINT CHR$(LR);:LOCATE ROW+1,COL+L+3:PRINT CHR$(MS);
12105 LOCATE ROW,COL+L+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR);
12110 LOCATE ROW+1,COL+L+2:PRINT " ";
12115 GOTO 12135
12120 LOCATE ROW+2,COL-1:PRINT STRING$(L+4,CHR$(TP));
12125 LOCATE ROW+1,COL+L+2:PRINT CHR$(MS);:LOCATE ROW,COL+L+2:PRINT CHR$(MS);
12130 LOCATE ROW-1,COL+L+2:PRINT CHR$(BT);
12135 BOX=0:SHADOW=0
12140 D1COL=COL:IF MODE=0 THEN D1$=LEFT$(TEMP$,2) ELSE D1$=LEFT$(DATE$,2)
12145 D2COL=COL+3:IF MODE=0 THEN D2$=MID$(TEMP$,4,2) ELSE D2$=MID$(DATE$,4,2)
12150 D3COL=COL+6:IF MODE=0 THEN D3$=MID$(TEMP$,7,2) ELSE D3$=MID$(DATE$,9,2)
12155 TEMPDATE$=D1$+"/"+D2$+"/"+D3$:TEMPCOL=COL:DEDKEYS=EDKEYS
12160 LOCATE ROW,COL:COLOR TEXTFORE,TEXTBACK:PRINT TEMPDATE$;
12165 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+8:PRINT " ";
12170 REM -----
12175 TEMP$=D1$:OLDD1$=D1$:COL=D1COL:LNG=2:INPTYPE=2:EDKEYS=2
12180 GOSUB 10000                                         :REM SUBROUTINE USED
12185 D1$=TEMP$
12190 IF EXIT$="ESC" THEN 12485
12195 IF LEFT$(EXIT$,1)="F" AND DEDKEYS>1 THEN 12485
12200 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND DEDKEYS>0 THEN 12485
12205 IF (EXIT$="UP" OR EXIT$="DOWN") AND DEDKEYS>0 THEN 12485
12210 IF VAL(D1$)=0 OR VAL(D1$)>12 THEN GOSUB 12500:GOTO 12175
12215 IF EXIT$="ENTER" AND D1$=OLDD1$ THEN 12455
12220 IF EXIT$="ENTER" AND D1$<>OLDD1$ THEN 12240
12225 IF EXIT$="LEFT" AND DEDKEYS>0 THEN 12455
12230 IF EXIT$="RIGHT" THEN 12240
12235 GOSUB 12500:GOTO 12175
12240 IF RIGHT$(D1$,1)=" " THEN D1$=LEFT$(D1$,1)
12245 IF LEFT$(D1$,1)=" " THEN D1$=RIGHT$(D1$,1)
12250 IF LEN(D1$)<2 THEN D1$="0"+D1$
12255 LOCATE ROW,D1COL:PRINT D1$;
12260 REM -----
12265 TEMP$=D2$:OLDD2$=D2$:COL=D2COL:LNG=2:INPTYPE=2:EDKEYS=2
12270 GOSUB 10000                                         :REM SUBROUTINE USED
12275 D2$=TEMP$
12280 IF EXIT$="ESC" THEN 12485
12285 IF LEFT$(EXIT$,1)="F" AND DEDKEYS>1 THEN 12485
12290 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND DEDKEYS>0 THEN 12485
12295 IF (EXIT$="UP" OR EXIT$="DOWN") AND DEDKEYS>0 THEN 12485
12300 IF VAL(D2$)=0 THEN GOSUB 12495:GOTO 12265
12305 IF D1$="04" AND VAL(D2$)>30 THEN GOSUB 12500:GOTO 12265
12310 IF D1$="06" AND VAL(D2$)>30 THEN GOSUB 12500:GOTO 12265
12315 IF D1$="09" AND VAL(D2$)>30 THEN GOSUB 12500:GOTO 12265
12320 IF D1$="11" AND VAL(D2$)>30 THEN GOSUB 12500:GOTO 12265
12325 IF EXIT$="RIGHT" THEN 12355
12330 IF VAL(D2$)>31 THEN GOSUB 12500:GOTO 12265
12335 IF EXIT$="ENTER" AND D2$=OLDD2$ THEN 12455
12340 IF EXIT$="ENTER" AND D2$<>OLDD2$ THEN 12355
12345 IF EXIT$="LEFT" THEN EDCOL=1:GOTO 12175
12350 GOSUB 12500:GOTO 12265
12355 IF RIGHT$(D2$,1)=" " THEN D2$=LEFT$(D2$,1)
12360 IF LEFT$(D2$,1)=" " THEN D2$=RIGHT$(D2$,1)
12365 IF LEN(D2$)<2 THEN D2$="0"+D2$
12370 LOCATE ROW,D2COL:PRINT D2$;
12375 REM -----
12380 TEMP$=D3$:COL=D3COL:LNG=2:INPTYPE=2:EDKEYS=2
12385 GOSUB 10000                                         :REM SUBROUTINE USED
12390 D3$=TEMP$
12395 IF EXIT$="ESC" THEN 12485
12400 IF LEFT$(EXIT$,1)="F" AND DEDKEYS>1 THEN 12485
12405 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND DEDKEYS>0 THEN 12485
12410 IF (EXIT$="UP" OR EXIT$="DOWN") AND DEDKEYS>0 THEN 12485
12415 IF VAL(D3$)<80 OR VAL(D3$)>99 THEN GOSUB 12500:GOTO 12380
12420 IF D1$="02" AND D2$="29" AND VAL(D3$) MOD 4<>0 THEN GOSUB 12500:GOTO 12265 
12425 IF EXIT$="ENTER" THEN 12455
12430 IF EXIT$="RIGHT" AND DEDKEYS>0 THEN 12445
12435 IF EXIT$="LEFT" THEN EDCOL=1:GOTO 12265
12440 GOSUB 12500:GOTO 12380
12445 LOCATE ROW,D3COL:PRINT D3$;
12450 REM -----
12455 IF MODE=2 THEN DATE$=D1$+"-"+D2$+"-"+"19"+D3$
12460 REM ----- NORMAL EXIT
12465 TEMP$=D1$+"/"+D2$+"/"+D3$
12470 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,TEMPCOL
12475 PRINT TEMP$;:GOTO 12510
12480 REM ----- ESCAPE EXIT
12485 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,TEMPCOL
12490 PRINT TEMPDATE$;:GOTO 12510
12495 REM ----- BEEP IF ERROR -----
12500 BEEP:RETURN
12505 REM ----- COMMON EXIT
12510 BOX=0:SHADOW=0:EDKEYS=0:MODE=0:RETURN
12515 REM
12860 REM ********************************************************************
12865 REM ------------------------- ENTER TIME -------------------------------
12870 REM
12875 REM This routine lets you enter the time in the format HH:MM:SS or
12880 REM optionally set the DOS time.
12885 REM
12890 REM enter with - ROW and COL=row and column at which to begin the prompt
12895 REM              (COL=35 for centered prompt)
12900 REM              MODE=0,1,2 - type of entry
12905 REM              0 = TEMP$ is initial time and entered time
12910 REM              1 = start with current time, TEMP$ = entered time
12915 REM              2 = start with current time, TEMP$ = entered time
12920 REM              and DOS time is set
12925 REM optional -   TEMP$="HH:MM:SS" - initial time
12930 REM optional -   EDKEYS=0,1,2 - what keys allow you to exit the routine
12935 REM              0 = only ENTER or ESCAPE
12940 REM              1 = include PGUP, PGDN, UP, DOWN, LEFT, RIGHT
12945 REM              2 = include F1-F10
12950 REM optional -   BOX=0,1,2,3 - type of box to draw around prompt
12955 REM              0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid
12960 REM optional-    SHADOW=0,1 - type of shadow to include with box
12965 REM              0 = no shadow, 1 = shadow
12970 REM optional -   TEXTFORE, TEXTBACK, DATAFORE, DATABACK
12975 REM              FIELDFORE, FIELDBACK, SHADOEFORE, SHADOWBACK
12980 REM              colors optionally specified for COLOR statements
12985 REM exit with -  TEMP$="HH:MM:SS" and DOS time set if MODE=1
12990 REM              BOX=0, SHADOW=0, EDKEYS=0 (to maintain as optional)
12995 REM
13000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                  :REM 13000
13005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15
13010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7
13015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8
13020 IF BOX=0 THEN 13135
13025 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195
13030 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204
13035 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219
13040 COLOR TEXTFORE,TEXTBACK
13045 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS);
13050 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+14:PRINT CHR$(UR);
13055 LOCATE ROW,COL+14:PRINT CHR$(MS);
13060 LOCATE ROW+1,COL+14:PRINT CHR$(LR);
13065 LOCATE ROW-1,COL-1:PRINT STRING$(15,CHR$(TP));
13070 LOCATE ROW+1,COL-1:PRINT STRING$(15,CHR$(BT));
13075 IF SHADOW=0 THEN 13135
13080 L=8:COLOR SHADOWFORE,SHADOWBACK
13085 IF BOX<>1 AND BOX<>2 THEN 13120
13090 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL);
13095 LOCATE ROW+2,COL+1:PRINT STRING$(L+2,CHR$(BT));
13100 LOCATE ROW+2,COL+L+3:PRINT CHR$(LR);:LOCATE ROW+1,COL+L+3:PRINT CHR$(MS);
13105 LOCATE ROW,COL+L+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR);
13110 LOCATE ROW+1,COL+L+2:PRINT " ";
13115 GOTO 13135
13120 LOCATE ROW+2,COL-1:PRINT STRING$(L+4,CHR$(TP));
13125 LOCATE ROW+1,COL+L+2:PRINT CHR$(MS);:LOCATE ROW,COL+L+2:PRINT CHR$(MS);
13130 LOCATE ROW-1,COL+L+2:PRINT CHR$(BT);
13135 BOX=0:SHADOW=0
13140 T1COL=COL:IF MODE=0 THEN T1$=LEFT$(TEMP$,2) ELSE T1$=LEFT$(TIME$,2)
13145 T2COL=COL+3:IF MODE=0 THEN T2$=MID$(TEMP$,4,2) ELSE T2$=MID$(TIME$,4,2)
13150 T3COL=COL+6:IF MODE=0 THEN T3$=MID$(TEMP$,7,2) ELSE T3$=MID$(TIME$,7,2)
13155 TEMPTIME$=T1$+":"+T2$+":"+T3$:TEMPCOL=COL:TEDKEYS=EDKEYS
13160 LOCATE ROW,COL:COLOR TEXTFORE,TEXTBACK:PRINT TEMPTIME$;
13165 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+8:PRINT " ";
13170 REM -----
13175 TEMP$=T1$:OLDT1$=T1$:COL=T1COL:LNG=2:INPTYPE=2:EDKEYS=2
13180 GOSUB 10000                                         :REM SUBROUTINE USED
13185 T1$=TEMP$
13190 IF EXIT$="ESC" THEN 13470
13195 IF LEFT$(EXIT$,1)="F" AND TEDKEYS>1 THEN 13470
13200 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND TEDKEYS>0 THEN 13470
13205 IF (EXIT$="UP" OR EXIT$="DOWN") AND TEDKEYS>0 THEN 13470
13210 IF T1$="" OR T1$=" " OR T1$="  " OR VAL(T1$)>23 THEN GOSUB 13485:GOTO 13175
13215 IF EXIT$="ENTER" AND T1$=OLDT1$ THEN 13440
13220 IF EXIT$="ENTER" AND T1$<>OLDT1$ THEN 13240
13225 IF EXIT$="LEFT" AND TEDKEYS>0 THEN 13440
13230 IF EXIT$="RIGHT" THEN 13240
13235 GOSUB 13485:GOTO 13175
13240 IF RIGHT$(T1$,1)=" " THEN T1$=LEFT$(T1$,1)
13245 IF LEFT$(T1$,1)=" " THEN T1$=RIGHT$(T1$,1)
13250 IF LEN(T1$)<2 THEN T1$="0"+T1$
13255 LOCATE ROW,T1COL:PRINT T1$;
13260 REM -----
13265 TEMP$=T2$:OLDT2$=T2$:COL=T2COL:LNG=2:INPTYPE=2:EDKEYS=2
13270 GOSUB 10000                                         :REM SUBROUTINE USED
13275 T2$=TEMP$
13280 IF EXIT$="ESC" THEN 13470
13285 IF LEFT$(EXIT$,1)="F" AND TEDKEYS>1 THEN 13470
13290 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND TEDKEYS>0 THEN 13470
13295 IF (EXIT$="UP" OR EXIT$="DOWN") AND TEDKEYS>0 THEN 13470
13300 IF T2$="" OR T2$=" " OR T2$="  " OR VAL(T2$)>59 THEN GOSUB 13485:GOTO 13265
13305 IF EXIT$="ENTER" AND T2$=OLDT2$ THEN 13440
13310 IF EXIT$="ENTER" AND T2$<>OLDT2$ THEN 13330
13315 IF EXIT$="RIGHT" THEN 13330
13320 IF EXIT$="LEFT" THEN EDCOL=1:GOTO 13175
13325 GOSUB 13485:GOTO 13265
13330 IF RIGHT$(T2$,1)=" " THEN T2$=LEFT$(T2$,1)
13335 IF LEFT$(T2$,1)=" " THEN T2$=RIGHT$(T2$,1)
13340 IF LEN(T2$)<2 THEN T2$="0"+T2$
13345 LOCATE ROW,T2COL:PRINT T2$;
13350 REM -----
13355 TEMP$=T3$:COL=T3COL:LNG=2:INPTYPE=2:EDKEYS=2
13360 GOSUB 10000                                         :REM SUBROUTINE USED
13365 T3$=TEMP$
13370 IF EXIT$="ESC" THEN 13470
13375 IF LEFT$(EXIT$,1)="F" AND TEDKEYS>1 THEN 13470
13380 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND TEDKEYS>0 THEN 13470
13385 IF (EXIT$="UP" OR EXIT$="DOWN") AND TEDKEYS>0 THEN 13470
13390 IF T3$="" OR T3$=" " OR T3$="  " OR VAL(T3$)>59 THEN GOSUB 13485:GOTO 13355
13395 IF EXIT$="ENTER" THEN 13440
13400 IF EXIT$="RIGHT" AND TEDKEYS>0 THEN 13415
13405 IF EXIT$="LEFT" THEN EDCOL=1:GOTO 13265
13410 GOSUB 13485:GOTO 13355
13415 IF RIGHT$(T3$,1)=" " THEN T3$=LEFT$(T3$,1)
13420 IF LEFT$(T3$,1)=" " THEN T3$=RIGHT$(T3$,1)
13425 IF LEN(T3$)<2 THEN T3$="0"+T3$
13430 LOCATE ROW,T3COL:PRINT T3$;
13435 REM -----
13440 IF MODE=2 THEN TIME$=T1$+":"+T2$+":"+T3$
13445 REM ----- NORMAL EXIT
13450 TEMP$=T1$+":"+T2$+":"+T3$
13455 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,TEMPCOL
13460 PRINT TEMP$;:GOTO 13495
13465 REM ----- ESCAPE EXIT
13470 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,TEMPCOL
13475 PRINT TEMPTIME$;:GOTO 13495
13480 REM ----- BEEP IF ERROR -----
13485 BEEP:RETURN
13490 REM ----- COMMON EXIT
13495 BOX=0:SHADOW=0:EDKEYS=0:RETURN
13500 REM
14850 REM *********************************************************************
14855 REM ------------- ENTER A DOLLAR AMOUNT AT ROW AND COLUMN ---------------
14860 REM
14865 REM This subroutine allows you to enter a dollar amount field at a
14870 REM specified row and column. It allows you to specify the maximum
14875 REM amount you may enter and allows you to optionally draw a box
14880 REM around the entering area. The numbers shift into the field from
14885 REM right to left and can be shifted back out with the BACKSPACE key.
14890 REM Hitting ESCAPE once clears the field and hitting ESCAPE again
14895 REM exits the routine. Hitting ENTER completes the entry.
14900 REM
14905 REM enter with - ROW and COL=row and column at which to enter the field
14910 REM              LNG=maximum length of the amount (8=99999.99)
14915 REM optional -   BOX=0,1,2,3 - type of box to draw around the area
14920 REM              0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid
14925 REM optional-    SHADOW=0,1 - type of shadow to include with box
14930 REM              0 = no shadow, 1 = shadow
14935 REM optional -   TEXTFORE, TEXTBACK, DATAFORE, DATABACK
14940 REM              FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK
14945 REM              colors optionally specified for COLOR statements
14950 REM optional -   EDKEYS=0,1 - what keys allow you to exit the routine
14955 REM              0 = only ENTER or ESCAPE
14960 REM              1 = include PGUP, PGDN, UP, DOWN, LEFT, RIGHT
14965 REM              2 = include F1-F10
14970 REM exit with -  TEMP$="dollars" entered
14975 REM              BOX=0,SHADOW=0,EDKEYS=0 (to maintain these as optional)
14980 REM              EXIT$=key hit that exited routine (ENTER or ESC)
14985 REM
14990 REM
14995 REM
15000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                  :REM 15000
15005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15
15010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7
15015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8
15020 TTTT$="":EXIT$=""
15025 IF BOX=0 THEN 15155
15030 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195
15035 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204
15040 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219
15045 COLOR TEXTFORE,TEXTBACK
15050 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS);
15055 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+LNG+1:PRINT CHR$(UR);
15060 LOCATE ROW,COL+LNG+1:PRINT CHR$(MS);
15065 LOCATE ROW+1,COL+LNG+1:PRINT CHR$(LR);
15070 LOCATE ROW-1,COL-1:PRINT STRING$(LNG+2,CHR$(TP));
15075 LOCATE ROW+1,COL-1:PRINT STRING$(LNG+2,CHR$(BT));
15080 IF SHADOW=0 THEN 15155
15085 COLOR SHADOWFORE,SHADOWBACK
15090 IF BOX<>1 AND BOX<>2 THEN 15130
15095 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL);
15100 LOCATE ROW+2,COL+1:PRINT STRING$(LNG+2,CHR$(BT));
15105 LOCATE ROW+2,COL+LNG+3:PRINT CHR$(LR);
15110 LOCATE ROW+1,COL+LNG+3:PRINT CHR$(MS);
15115 LOCATE ROW,COL+LNG+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR);
15120 COLOR TEXTFORE,TEXTBACK:LOCATE ROW+1,COL+LNG+2:PRINT " ";
15125 GOTO 15155
15130 LOCATE ROW+2,COL-1:PRINT STRING$(LNG+4,CHR$(TP));
15135 LOCATE ROW+1,COL+LNG+2:PRINT CHR$(MS);
15140 LOCATE ROW,COL+LNG+2:PRINT CHR$(MS);
15145 LOCATE ROW-1,COL+LNG+2:PRINT CHR$(BT);
15150 REM -----
15155 IF LEN(TTTT$)=0 THEN TEMP$="0.00":GOTO 15175
15160 IF LEN(TTTT$)=1 THEN TEMP$="0.0"+TTTT$:GOTO 15175
15165 IF LEN(TTTT$)=2 THEN TEMP$="0."+TTTT$:GOTO 15175
15170 TEMP$=LEFT$(TTTT$,LEN(TTTT$)-2)+"."+RIGHT$(TTTT$,2)
15175 COLOR FIELDFORE,FIELDBACK:LOCATE ROW,COL
15180 PRINT STRING$(LNG-LEN(TEMP$)," ")+TEMP$;:COLOR TEXTFORE,TEXTBACK
15185 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+LNG:PRINT " ";
15190 IN$=INKEY$:IF IN$="" THEN 15190                      :REM --------------
15195 IF IN$=CHR$(27) THEN 15360                           :REM ESCAPE       |
15200 ESCFLAG=0                                            :REM clear flag   |
15205 IF IN$=CHR$(13) THEN EXIT$="ENTER":GOTO 15375        :REM ENTER        |
15210 IF IN$=CHR$(8) THEN 15340                            :REM BACKSPACE    |
15215 IF EDKEYS=0 THEN 15305                               :REM skip these - |
15220 IF IN$=CHR$(0)+CHR$(75) THEN EXIT$="LEFT":GOTO 15375 :REM LEFT ARROW   |
15225 IF IN$=CHR$(0)+CHR$(77) THEN EXIT$="RIGHT":GOTO 15375:REM RIGHT ARROW  |
15230 IF IN$=CHR$(0)+CHR$(72) THEN EXIT$="UP":GOTO 15375   :REM UP ARROW     |
15235 IF IN$=CHR$(0)+CHR$(80) THEN EXIT$="DOWN":GOTO 15375 :REM DOWN ARROW   |
15240 IF IN$=CHR$(0)+CHR$(73) THEN EXIT$="PGUP":GOTO 15375 :REM PAGE UP      |
15245 IF IN$=CHR$(0)+CHR$(81) THEN EXIT$="PGDN":GOTO 15375 :REM PAGE DOWN    |
15250 IF EDKEYS=1 THEN 15305                               :REM skip these - |
15255 IF IN$=CHR$(0)+CHR$(59) THEN EXIT$="F1":GOTO 15375   :REM F1           |
15260 IF IN$=CHR$(0)+CHR$(60) THEN EXIT$="F2":GOTO 15375   :REM F2           |
15265 IF IN$=CHR$(0)+CHR$(61) THEN EXIT$="F3":GOTO 15375   :REM F3           |
15270 IF IN$=CHR$(0)+CHR$(62) THEN EXIT$="F4":GOTO 15375   :REM F4           |
15275 IF IN$=CHR$(0)+CHR$(63) THEN EXIT$="F5":GOTO 15375   :REM F5           |
15280 IF IN$=CHR$(0)+CHR$(64) THEN EXIT$="F6":GOTO 15375   :REM F6           |
15285 IF IN$=CHR$(0)+CHR$(65) THEN EXIT$="F7":GOTO 15375   :REM F7           |
15290 IF IN$=CHR$(0)+CHR$(66) THEN EXIT$="F8":GOTO 15375   :REM F8           |
15295 IF IN$=CHR$(0)+CHR$(67) THEN EXIT$="F9":GOTO 15375   :REM F9           |
15300 IF IN$=CHR$(0)+CHR$(68) THEN EXIT$="F10":GOTO 15375  :REM F10          |
15305                                                      :REM --------------
15310 REM ----- allow only numbers
15315 IF ASC(IN$)<48 OR ASC(IN$)>57 THEN GOSUB 15400:GOTO 15190
15320 IF LEN(TTTT$)>=LNG-1 THEN GOSUB 15400:GOTO 15190
15325 TTTT$=TTTT$+IN$:GOTO 15155
15330 REM ----- BACKSPACE -----
15335 REM ----- error if blank
15340 IF LEN(TTTT$)=0 THEN GOSUB 15400:GOTO 15190
15345 REM ----- good backspace
15350 TTTT$=LEFT$(TTTT$,LEN(TTTT$)-1):GOTO 15155
15355 REM ----- ESCAPE -----
15360 IF ESCFLAG THEN EXIT$="ESC":GOTO 15375
15365 ESCFLAG=-1:TTTT$="":GOTO 15155
15370 REM ----- COMMON EXIT -----
15375 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,COL
15380 PRINT STRING$(LNG-LEN(TEMP$)," ")+TEMP$;
15385 BOX=0:EDKEYS=0:ESCFLAG=0:RETURN
15390 REM
15395 REM ----- BEEP IF ERROR -----
15400 BEEP:RETURN
15405 REM
15410 REM
15415 REM
18980 REM ********************************************************************
18985 REM --------------------- wait for any key -----------------------------
18990 REM                   nothing needed on entry
18995 REM
19000 LOCATE ,,0                                                    :REM 19000
19005 IN$=INKEY$:IF IN$="" THEN 19005
19010 RETURN
19015 REM
19020 REM
19025 REM
19080 REM ********************************************************************
19085 REM -------------------------- DELAY -----------------------------------
19090 REM               enter with DELAY=seconds to delay
19095 REM
19100 LOCATE ,,0:T=TIMER                                            :REM 19100
19105 IF TIMER<T+DELAY THEN 19105
19110 RETURN
19115 REM
19120 REM
19175 REM ********************************************************************
19180 REM --------- DELAY OR HIT ANY KEY TO EXIT FROM DELAY ------------------
19185 REM               enter with DELAY=seconds to delay
19190 REM    exit with ESCAPE=-1 (TRUE) if key hit before time ended
19195 REM
19200 LOCATE ,,0:T=TIMER:ESCAPE=0                                   :REM 19200
19205 IN$=INKEY$:IF IN$<>"" THEN ESCAPE=-1:GOTO 19215
19210 IF TIMER<T+DELAY THEN 19205
19215 RETURN
19220 REM
19225 REM
19880 REM ********************************************************************
19885 REM ------------ SELECT A FILE WITH A SPECIFIED EXTENSION --------------
19890 REM Move among names with arrow and page keys and select file with ENTER
19895 REM key, or exit with ESCAPE key. Message is displayed on on row 1. 
19900 REM
19905 REM enter with -
19910 REM    MSG$="message", to display
19915 REM    EXT$="ext", extension of files desired
19920 REM optional-
19925 REM    TEXTFORE, TEXTBACK, DATAFORE, DATABACK
19930 REM    FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK 
19935 REM    colors optionally specified for COLOR statements
19940 REM    BOX=0,1,2,3 - type of box around message and field
19945 REM    0 = no box, 1 = 1 line box, 2 = 2 line box, 3 = solid box
19950 REM optional-
19955 REM    SHADOW=0,1 - type of shadow to include with box
19960 REM    0 = no shadow, 1 = shadow
19965 REM exit with -
19970 REM    FILE$="filename", the filename selected without the extension
19975 REM    ESCAPE TRUE (=-1) if ESCAPE key hit
19980 REM    NUMFILES=number of files found with the specified extension
19985 REM    BOX=0, SHADOW=0 (to maintain as optional)
19990 REM    DOSERROR$="NONE" or "DISK" if an error occurs
19995 REM
20000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                  :REM 20000
20005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15
20010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7
20015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8
20020 LOCATE ,,0:COLOR TEXTFORE,TEXTBACK:CLS
20025 SHEL$="DIR *."+EXT$+" | SORT > FILES.TMP":SHELL SHEL$
20030 ON ERROR GOTO 20080
20035 OPEN "FILES.TMP" FOR INPUT AS 1
20040 IF LOF(1)=0 THEN CLOSE #1:GOTO 20050
20045 GOTO 20100
20050 PRINT:PRINT "SORT utility not in DOS path"
20055 SHEL$="DIR *."+EXT$+" > FILES.TMP":SHELL SHEL$
20060 ON ERROR GOTO 20080
20065 OPEN "FILES.TMP" FOR INPUT AS 1
20070 IF LOF(1)=0 THEN CLOSE #1:GOTO 20085
20075 GOTO 20100
20080 RESUME 20085
20085 DOSERROR$="DISK":NUMFILES=0:FILE$=""
20090 ON ERROR GOTO 0:GOTO 20645
20095 REM -----
20100 ON ERROR GOTO 0
20105 DOSERROR$="NONE"
20110 DIM FILENAME$(1000):NUMFILES=0
20115 IF EOF(1) THEN 20160
20120 INPUT #1,FILE$
20125 IF MID$(FILE$,9,1)<>" " OR LEFT$(FILE$,1)="." THEN 20115
20130 IF VAL(MID$(FILE$,14,13))=0 THEN 20115
20135 FILENAME$(NUMFILES+1)=LEFT$(FILE$,8)
20140 NUMFILES=NUMFILES+1
20145 IF NUMFILES>1000 THEN 20160
20150 GOTO 20115
20155 REM -----
20160 CLOSE 1:KILL "FILES.TMP"
20165 IF NUMFILES=0 THEN FILE$="":GOTO 20645
20170 ON ERROR GOTO 0
20175 COL=35
20180 REM ----- OUTLINE THE AREA
20185 COLOR TEXTFORE,TEXTBACK:CLS
20190 IF BOX=0 THEN 20340
20195 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195
20200 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204
20205 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219
20210 ROW=3:LOCATE ROW,1+COL:PRINT STRING$(10,CHR$(TP));
20215 ROW=23:LOCATE ROW,1+COL:PRINT STRING$(10,CHR$(BT));
20220 DCOL=COL:FOR ROW%=4 TO 22:LOCATE ROW%,DCOL:PRINT CHR$(MS);:NEXT ROW%
20225 DCOL=COL+11:FOR ROW%=4 TO 22:LOCATE ROW%,DCOL:PRINT CHR$(MS);:NEXT ROW%
20230 LOCATE 3,COL:PRINT CHR$(UL);:LOCATE 3,COL+11:PRINT CHR$(UR);
20235 LOCATE 23,COL:PRINT CHR$(LL);:LOCATE 23,COL+11:PRINT CHR$(LR);
20240 IF SHADOW=0 THEN 20340
20245 ROW=4:L=8:COLOR SHADOWFORE,SHADOWBACK
20250 IF BOX<>1 AND BOX<>2 THEN 20315
20255 LOCATE ROW+19,COL+2:PRINT CHR$(DN);:LOCATE ROW+20,COL+2:PRINT CHR$(LL);
20260 LOCATE ROW+20,COL+3:PRINT STRING$(L+2,CHR$(BT));
20265 LOCATE ROW+20,COL+L+5:PRINT CHR$(LR);
20270 FOR DROW%=ROW+19 TO ROW+1 STEP -1
20275   LOCATE DROW%,COL+L+5:PRINT CHR$(MS);
20280 NEXT DROW%
20285 LOCATE ROW,COL+L+3:PRINT CHR$(RT);CHR$(TP);CHR$(UR);
20290 COLOR TEXTFORE,TEXTBACK
20295 FOR DROW%=ROW+1 TO ROW+19
20300   LOCATE DROW%,COL+L+4:PRINT " ";
20305 NEXT DROW%
20310 GOTO 20340
20315 LOCATE ROW+20,COL+1:PRINT STRING$(L+4,CHR$(TP));
20320 FOR DROW%=ROW+19 TO ROW STEP -1
20325   LOCATE DROW%,COL+L+4:PRINT CHR$(MS);
20330 NEXT DROW%
20335 LOCATE ROW-1,COL+L+4:PRINT CHR$(BT);
20340 REM
20345 REM ----- DISPLAY MESSAGE
20350 ROW=1:MCOL=41-INT((LEN(MSG$)/2))
20355 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,MCOL:PRINT MSG$;
20360 ROW=25:MSG$="Use "+CHR$(24)+" and "+CHR$(25)+" to Move, "
20365 MSG$=MSG$+"PgUp and PgDn for More Files, ENTER to Select"
20370 MCOL=41-INT((LEN(MSG$)/2))
20375 LOCATE ROW,MCOL:PRINT MSG$;
20380 REM -----
20385 CURROW=1:OLDROW=CURROW
20390 MAXROW=19:IF NUMFILES<19 THEN MAXROW=NUMFILES
20395 SRTROW=1
20400 REM ----- DISPLAY FILE NAMES
20405 COLOR DATAFORE,DATABACK
20410 FOR DROW%=1 TO MAXROW
20415   LOCATE DROW%+3,COL+2
20420   PRINT FILENAME$(DROW%-1+SRTROW);
20425 NEXT DROW%
20430 REM ----- MOVE THROUGH FILE NAMES AND SELECT ONE
20435 ESCAPE=0:LOCATE ,,0
20440 LOCATE CURROW+3,COL+2
20445 COLOR FIELDFORE,FIELDBACK
20450 PRINT FILENAME$(CURROW-1+SRTROW);
20455 COLOR DATAFORE,DATABACK
20460 LOCATE CURROW+3,COL+2
20465 IN$=INKEY$:IF IN$="" THEN 20465
20470 IF IN$=CHR$(13) THEN 20625
20475 IF IN$=CHR$(27) THEN ESCAPE=-1:FILE$="":GOTO 20645
20480 IF IN$=CHR$(0)+CHR$(72) THEN 20510:REM UP
20485 IF IN$=CHR$(0)+CHR$(80) THEN 20525:REM DOWN
20490 IF IN$=CHR$(0)+CHR$(73) THEN 20540:REM PAGE UP
20495 IF IN$=CHR$(0)+CHR$(81) THEN 20555:REM PAGE DOWN
20500 GOTO 20575
20505 REM -----
20510 IF CURROW>1 THEN OLDROW=CURROW:CURROW=CURROW-1:GOTO 20585
20515 IF SRTROW>1 THEN SRTROW=SRTROW-1:GOTO 20405
20520 GOTO 20575
20525 IF CURROW<MAXROW THEN OLDROW=CURROW:CURROW=CURROW+1:GOTO 20585
20530 IF NUMFILES>MAXROW AND SRTROW<=NUMFILES-19 THEN SRTROW=SRTROW+1:GOTO 20405
20535 GOTO 20575
20540 IF SRTROW>18 THEN SRTROW=SRTROW-18:GOTO 20405
20545 IF SRTROW<>1 THEN SRTROW=1:GOTO 20405
20550 GOTO 20575
20555 IF SRTROW+18<=NUMFILES-19 THEN SRTROW=SRTROW+18:GOTO 20405
20560 IF SRTROW<=NUMFILES-19 THEN SRTROW=NUMFILES-18:GOTO 20405
20565 GOTO 20575
20570 REM ----- BEEP ON ERROR WOULD GO HERE
20575 BEEP:GOTO 20465
20580 REM ----- HIGHLIGHT NEW FILE
20585 LOCATE OLDROW+3,COL+2
20590 COLOR DATAFORE,DATABACK
20595 PRINT FILENAME$(OLDROW-1+SRTROW);
20600 LOCATE CURROW+3,COL+2
20605 COLOR FIELDFORE,FIELDBACK
20610 PRINT FILENAME$(CURROW-1+SRTROW);
20615 GOTO 20465
20620 REM ----- FILE WAS SELECTED
20625 FILE$=FILENAME$(CURROW-1+SRTROW)
20630 REM ----- REMOVE TRAILING SPACES
20635 IF RIGHT$(FILE$,1)=" " THEN FILE$=LEFT$(FILE$,LEN(FILE$)-1):GOTO 20635
20640 REM -----
20645 ERASE FILENAME$
20650 COLOR TEXTFORE,TEXTBACK:BOX=0:SHADOW=0:RETURN
20655 REM
20900 REM ********************************************************************
20905 REM --------- SELECT FROM FILE NAMES OF A SPECIFIED EXTENSION ----------
20910 REM Move among names with arrow keys and select file with ENTER key, or
20915 REM exit with ESCAPE key. Message on row 2, files begin on row 4. Number
20920 REM of files is limited to 133. DOS must have COMMAND.COM in path.
20925 REM
20930 REM enter with -
20935 REM    MSG$="message", to display
20940 REM    EXT$="ext", extension of files desired
20945 REM optional-
20950 REM    TEXTFORE,TEXTBACK,DATAFORE,DATABACK,FIELDFORE,FIELDBACK - 
20955 REM    colors optionally specified for COLOR statements
20960 REM    BOX=0,1,2,3 - type of box around message and field
20965 REM    0 = no box, 1 = 1 line box, 2 = 2 line box, 3 = solid box
20970 REM exit with -
20975 REM    FILE$="filename", the filename without extension
20980 REM    ESCAPE TRUE (=-1) if ESCAPE key hit
20985 REM    NUMFILES=number of files found of the specified extension
20990 REM    BOX=0 (to maintain BOX as optional for other routines)
20995 REM
21000 DIM FILENAME1$(256,7)                                        :REM 21000
21005 SHEL$="DIR *."+EXT$+" > FILES.TMP"
21010 LOCATE ,,0:COLOR TEXTFORE,TEXTBACK:CLS
21015 SHELL SHEL$:REM DOS MUST HAVE COMMAND.COM IN THE PATH
21020 OPEN "FILES.TMP" FOR INPUT AS 1
21025 NUMFILES=0:FROW=1:FCOL=1:MAXROW=1:MAXCOL=1
21030 IF EOF(1) THEN 21100
21035 INPUT #1,FILE$
21040 EXTPOS=INSTR(FILE$," "+EXT$)-1
21045 IF EXTPOS<1 OR LEN(FILE$)=0 THEN 21095
21050 FILE$=LEFT$(FILE$,EXTPOS)
21055 SPCPOS=INSTR(FILE$," ")-1
21060 IF SPCPOS<1 OR LEN(FILE$)=0 THEN 21070
21065 FILE$=LEFT$(FILE$,SPCPOS)
21070 FILENAME1$(FROW,FCOL)=FILE$
21075 NUMFILES=NUMFILES+1
21080 FCOL=FCOL+1
21085 IF FCOL=8 THEN FCOL=1:FROW=FROW+1               :REM NUMBER OF COLUMNS+1
21090 IF FCOL>MAXCOL THEN MAXCOL=FCOL
21095 GOTO 21030
21100 MAXROW=FROW:IF MAXROW=1 THEN MAXCOL=MAXCOL-1
21105 CLOSE 1:KILL "FILES.TMP"
21110 IF NUMFILES=0 THEN FILE$="":GOTO 21445
21115 REM -----
21120 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7
21125 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15
21130 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7
21135 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8
21140 REM ----- OUTLINE THE AREA
21145 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A%
21150 LOCATE ,,0:COLOR TEXTFORE,TEXTBACK:CLS
21155 IF BOX=0 THEN 21205
21160 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217
21165 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188
21170 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219
21175 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP));
21180 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT));
21185 COL=1:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW%
21190 COL=80:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW%
21195 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR);
21200 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR);
21205 BOX=0
21210 REM ----- DISPLAY MESSAGE
21215 ROW=2
21220 COL=41-INT((LEN(MSG$)/2))
21225 LOCATE ROW,COL:PRINT MSG$;
21230 REM ----- DISPLAY FILE NAMES
21235 FILEROW=4:COLOR DATAFORE,DATABACK:REM set colors for DATA
21240 FOR DROW%=1 TO FROW
21245  FOR DCOL%=1 TO MAXCOL
21250   LOCATE DROW%-1+FILEROW,((DCOL%-1)*11)+4            :REM COLUMN SPACING
21255   PRINT FILENAME1$(DROW%,DCOL%)
21260  NEXT DCOL%
21265 NEXT DROW%
21270 REM ----- MOVE THROUGH FILE NAMES AND SELECT ONE
21275 ESCAPE=0:LOCATE ,,0:FROW=1:FCOL=1:OLDFROW=FROW:OLDFCOL=FCOL
21280 LOCATE FROW-1+FILEROW,FCOL+3                         :REM COLUMN SPACING
21285 COLOR FIELDFORE,FIELDBACK:REM set colors for FIELD
21290 PRINT FILENAME1$(FROW,FCOL)
21295 COLOR DATAFORE,DATABACK:REM set colors for DATA
21300 LOCATE FROW-1+FILEROW,FCOL+4
21305 IN$=INKEY$:IF IN$="" THEN 21305
21310 IF IN$=CHR$(13) THEN 21440
21315 IF IN$=CHR$(27) THEN ESCAPE=-1:FILE$="":GOTO 21445
21320 IF IN$=CHR$(0)+CHR$(75) THEN 21355:REM LEFT
21325 IF IN$=CHR$(0)+CHR$(77) THEN 21365:REM RIGHT
21330 IF IN$=CHR$(0)+CHR$(72) THEN 21375:REM UP
21335 IF IN$=CHR$(0)+CHR$(80) THEN 21385:REM DOWN
21340 REM ----- BEEP ON ERROR
21345 BEEP:GOTO 21305
21350 REM
21355 IF FCOL>1 THEN OLDFROW=FROW:OLDFCOL=FCOL:FCOL=FCOL-1
21360 GOTO 21395
21365 IF FCOL<MAXCOL THEN OLDFROW=FROW:OLDFCOL=FCOL:FCOL=FCOL+1
21370 GOTO 21395
21375 IF FROW>1 THEN OLDFROW=FROW:OLDFCOL=FCOL:FROW=FROW-1
21380 GOTO 21395
21385 IF FROW<MAXROW THEN OLDFROW=FROW:OLDFCOL=FCOL:FROW=FROW+1
21390 GOTO 21395
21395 IF FILENAME1$(FROW,FCOL)<>"" THEN 21405
21400 FROW=OLDFROW:FCOL=OLDFCOL
21405 LOCATE OLDFROW-1+FILEROW,((OLDFCOL-1)*11)+4          :REM COLUMN SPACING
21410 PRINT FILENAME1$(OLDFROW,OLDFCOL)
21415 LOCATE FROW-1+FILEROW,((FCOL-1)*11)+4                :REM COLUMN SPACING
21420 COLOR FIELDFORE,FIELDBACK:REM set colors for FIELD
21425 PRINT FILENAME1$(FROW,FCOL)
21430 COLOR DATAFORE,DATABACK:REM set colors for DATA
21435 GOTO 21305
21440 FILE$=FILENAME1$(FROW,FCOL)
21445 ERASE FILENAME1$
21450 COLOR TEXTFORE,TEXTBACK:RETURN
21455 REM
21460 REM
29780 REM ********************************************************************
29785 REM ---------------------- POINT AND SHOOT MENU ------------------------
29790 REM ----------------------- (or display window) ------------------------
29795 REM
29800 REM Sets up menu and selects from up to 9 items. Moves among the items
29805 REM with the arrow keys and selects with ENTER or ESCAPE keys, numbers
29810 REM 1-9, F1-F9, and optionally PAGE UP, PAGE DOWN, LEFT, RIGHT, F10.
29815 REM Displays message at top and optional box and shadow around the menu.
29820 REM Item names must be in order and none may be skipped. The ROW and COL
29825 REM must allow all of menu to be displayed on the screen. Menu can be
29830 REM optionally displayed as a pull-down menu, meaning that when item is
29835 REM selected, parts of the screen that were written over are restored.
29840 REM
29845 REM With the display window option set, the menu becomes only a display
29850 REM of text and does not wait for any keyboard entry.
29855 REM 
29860 REM enter with ITEM$(1)="ITEM 1 message",(up to 76 chars.),ITEM$(2), etc.
29865 REM            (array must be DIMinsioned before using this routine)
29870 REM            MSG$="menu message or name", (up to 76 characters)
29875 REM            ROW, COL=upper left corner of menu
29880 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK
29885 REM            FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK
29890 REM            colors optionally specified for COLOR statements
29895 REM            BOX=0,1,2,3 - type of outline around menu
29900 REM            0 = no box, 1 = 1 line box, 2 = 2 line box, 3 = solid box
29905 REM optional-  SHADOW=0,1 - type of shadow to include with box
29910 REM            0 = no shadow, 1 = shadow
29915 REM optional - EDKEYS=0,1 - what keys allow you to exit the routine
29920 REM            0 = only ENTER or ESCAPE
29925 REM            1 = include PGUP, PGDN, LEFT and RIGHT ARROWS, F10
29930 REM            ITEM = 1 to number of items, default item selected
29935 REM optional - DISPTYPE=0,1,2,3  - type of menu/display desired
29940 REM            0 = normal menu
29945 REM            1 = pull-down menu (screen restored),
29950 REM            2 = display window of text only that looks just like menu
29955 REM            3 = display window with default "ITEM" hi-lighted
29960 REM exit with -ITEM = 1-9, item selected
29965 REM            ITEM$ = ITEM$(1)-ITEM$(9), depending on item selected
29970 REM            ESCAPE=-1 (TRUE) if ESCAPE key hit
29975 REM            (for compatibility with old versions)
29980 REM            EXIT$=key hit that exited routine-
29985 REM            "ENTER","ESC","PGUP","PGDN","LEFT","RIGHT","F10"
29990 REM            BOX, SHADOW, DISPTYPE, EDKEYS=0 (to maintain as optional)
29995 REM
30000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                  :REM 30000
30005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15
30010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7
30015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8
30020 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A%
30025 NUMITEMS=0:EXIT$="":ESCAPE=0
30030 FOR A%=1 TO 9:IF ITEM$(A%)="" THEN 30040
30035 NUMITEMS=NUMITEMS+1:NEXT A%
30040 IF NUMITEMS+ROW+3>25 THEN ROW=25-3-NUMITEMS
30045 REM -------------- FIND MAX LNG AND PAD SHORTER ONES ---------------
30050 MAXLEN=LEN(MSG$)
30055 FOR MLOOP%=1 TO NUMITEMS
30060   IF LEN(ITEM$(MLOOP%))>MAXLEN THEN MAXLEN=LEN(ITEM$(MLOOP%))
30065 NEXT MLOOP%
30070 IF LEN(MSG$)<MAXLEN THEN MSG$=MSG$+SPACE$(MAXLEN-LEN(MSG$))
30075 FOR MLOOP%=1 TO NUMITEMS
30080   IF LEN(ITEM$(MLOOP%))<MAXLEN THEN ITEM$(MLOOP%)=ITEM$(MLOOP%)+SPACE$(MAXLEN-LEN(ITEM$(MLOOP%)))
30085 NEXT MLOOP%
30090 IF MAXLEN+COL+3>80 THEN COL=80-3-MAXLEN
30095 REM --------------- SAVE SCREEN IF PULL DOWN MENU ----------------
30100 IF DISPTYPE<>1 THEN 30170
30105 IF SHADOW<>0 THEN SHAD=2 ELSE SHAD=0
30110 DIM PSSSCHR(NUMITEMS+4+SHAD,MAXLEN+4+SHAD)
30115 DIM PSSSCOLOR(NUMITEMS+4+SHAD,MAXLEN+4+SHAD,2)
30120 R=1:C=1
30125 FOR SR%=ROW TO ROW+NUMITEMS+3+SHAD
30130   FOR SC%=COL TO COL+MAXLEN+3+SHAD
30135     PSSSCHR(R,C)=SCREEN(SR%,SC%,0)
30140     A=SCREEN(SR%,SC%,1):PSSSCOLOR(R,C,1)=(A AND 15)
30145     IF (A AND 128)=128 THEN PSSSCOLOR(R,C,1)=PSSSCOLOR(R,C,1)+16
30150     PSSSCOLOR(R,C,2)=(A AND 112)/16
30155   C=C+1:NEXT SC%
30160 R=R+1:C=1:NEXT SR%
30165 REM ---------------------- DISPLAY MENU -----------------------------
30170 LOCATE ,,0
30175 IF BOX=0 THEN TP=0:BT=0:LS=0:RS=0:MS=0:MM=0:UL=0:LL=0:UR=0:LR=0
30180 IF BOX=1 THEN TP=196:BT=196:LS=195:RS=180:MS=179:MM=196:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195
30185 IF BOX=2 THEN TP=205:BT=205:LS=204:RS=185:MS=186:MM=205:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204
30190 IF BOX=3 THEN TP=223:BT=220:LS=219:RS=219:MS=219:MM=220:UL=219:LL=219:UR=219:LR=219
30195 IROW=ROW:ICOL=COL
30200 LOCATE IROW,ICOL:COLOR TEXTFORE,TEXTBACK
30205 PRINT CHR$(UL)+STRING$(MAXLEN+2,TP)+CHR$(UR);
30210 LOCATE IROW+1,ICOL:PRINT CHR$(MS)+" ";
30215 COLOR DATAFORE,DATABACK:PRINT MSG$;
30220 COLOR TEXTFORE,TEXTBACK:PRINT " "+CHR$(MS);
30225 LOCATE IROW+2,ICOL:COLOR TEXTFORE,TEXTBACK
30230 PRINT CHR$(LS)+STRING$(MAXLEN+2,MM)+CHR$(RS);
30235 FOR PLOOP%=1 TO NUMITEMS
30240   LOCATE IROW+2+PLOOP%,ICOL
30245   PRINT CHR$(MS)+" "+ITEM$(PLOOP%)+" "+CHR$(MS);
30250 NEXT PLOOP%
30255 LOCATE IROW+3+NUMITEMS,ICOL
30260 PRINT CHR$(LL)+STRING$(MAXLEN+2,BT)+CHR$(LR);
30265 REM
30270 IF SHADOW=0 THEN 30375
30275 COLOR SHADOWFORE,SHADOWBACK
30280 IF BOX<>1 AND BOX<>2 THEN 30350
30285 LOCATE ROW+3+NUMITEMS,COL+2:PRINT CHR$(DN);
30290 LOCATE ROW+4+NUMITEMS,COL+2:PRINT CHR$(LL);
30295 LOCATE ROW+4+NUMITEMS,COL+3:PRINT STRING$(MAXLEN+2,CHR$(BT));
30300 LOCATE ROW+4+NUMITEMS,COL+MAXLEN+5:PRINT CHR$(LR);
30305 FOR DROW%=ROW+3+NUMITEMS TO ROW+2 STEP -1
30310   LOCATE DROW%,COL+MAXLEN+5:PRINT CHR$(MS);
30315 NEXT DROW%
30320 LOCATE ROW+1,COL+MAXLEN+3:PRINT CHR$(RT);CHR$(TP);CHR$(UR);
30325 COLOR TEXTFORE,TEXTBACK
30330 FOR DROW%=ROW+2 TO ROW+3+NUMITEMS
30335   LOCATE DROW%,COL+MAXLEN+4:PRINT " ";
30340 NEXT DROW%
30345 GOTO 30375
30350 LOCATE ROW+4+NUMITEMS,COL+1:PRINT STRING$(MAXLEN+4,CHR$(TP));
30355 FOR DROW%=ROW+3+NUMITEMS TO ROW+1 STEP -1
30360   LOCATE DROW%,COL+MAXLEN+4:PRINT CHR$(MS);
30365 NEXT DROW%
30370 LOCATE ROW,COL+MAXLEN+4:PRINT CHR$(BT);
30375 REM
30380 REM ---------- DO NOT WAIT FOR ENTRY IF DISPLAY WINDOW ONLY ----------
30385 IF DISPTYPE=2 THEN 30545:REM DISPLAY WINDOW
30390 IF DISPTYPE=3 THEN IROW=ITEM:ICOL=ICOL+2:GOTO 30535:REM WIND. WITH HILITE
30395 REM ------------- MOVE THROUGH MENU ITEMS AND SELECT ONE --------------
30400 IROW=1:IF ITEM>=1 AND ITEM<=NUMITEMS THEN IROW=ITEM
30405 ESCAPE=0:OLDIROW=IROW:ICOL=COL+2
30410 LOCATE OLDIROW+ROW+2,ICOL:COLOR TEXTFORE,TEXTBACK:PRINT ITEM$(OLDIROW);
30415 LOCATE IROW+ROW+2,ICOL:COLOR FIELDFORE,FIELDBACK:PRINT ITEM$(IROW);
30420 IN$=INKEY$:IF IN$="" THEN 30420
30425 IF IN$=CHR$(27) THEN EXIT$="ESC":ESCAPE=-1:GOTO 30525
30430 IF IN$=CHR$(13) THEN EXIT$="ENTER":GOTO 30525
30435 IF EDKEYS=0 THEN 30465
30440 IF IN$=CHR$(0)+CHR$(75) THEN EXIT$="LEFT":GOTO 30525
30445 IF IN$=CHR$(0)+CHR$(77) THEN EXIT$="RIGHT":GOTO 30525
30450 IF IN$=CHR$(0)+CHR$(73) THEN EXIT$="PGUP":GOTO 30525
30455 IF IN$=CHR$(0)+CHR$(81) THEN EXIT$="PGDN":GOTO 30525
30460 IF IN$=CHR$(0)+CHR$(68) THEN EXIT$="F10":GOTO 30525
30465 IF LEN(IN$)=1 THEN 30475
30470 V=ASC(RIGHT$(IN$,1))-58:GOTO 30480:REM FUNCTION KEY
30475 V=VAL(IN$)
30480 IF V>=1 AND V<=9 AND V<=NUMITEMS THEN OLDIROW=IROW:IROW=V:GOTO 30525
30485 IF IN$=CHR$(0)+CHR$(72) THEN 30500:REM UP
30490 IF IN$=CHR$(0)+CHR$(80) THEN 30510:REM DOWN
30495 BEEP:GOTO 30420
30500 OLDIROW=IROW:IF IROW>1 THEN IROW=IROW-1:GOTO 30410
30505 IROW=NUMITEMS:GOTO 30410
30510 OLDIROW=IROW:IF IROW<NUMITEMS THEN IROW=IROW+1:GOTO 30410
30515 IROW=1:GOTO 30410
30520 REM --------------------- ITEM SELECTED, EXIT ------------------------
30525 ITEM=IROW:ITEM$=ITEM$(IROW)
30530 LOCATE OLDIROW+ROW+2,ICOL:COLOR TEXTFORE,TEXTBACK:PRINT ITEM$(OLDIROW);
30535 LOCATE IROW+ROW+2,ICOL:COLOR DATAFORE,DATABACK:PRINT ITEM$(IROW);
30540 REM --------------- RESTORE SCREEN IF PULL DOWN MENU -----------------
30545 IF DISPTYPE<>1 THEN 30595
30550 R=1:C=1
30555 FOR SR%=ROW TO ROW+NUMITEMS+3+SHAD
30560   FOR SC%=COL TO COL+MAXLEN+3+SHAD
30565     COLOR PSSSCOLOR(R,C,1),PSSSCOLOR(R,C,2)
30570     LOCATE SR%,SC%:PRINT CHR$(PSSSCHR(R,C));
30575     C=C+1:NEXT SC%
30580   R=R+1:C=1:NEXT SR%
30585 ERASE PSSSCHR:ERASE PSSSCOLOR
30590 REM -------------------------------------------------------
30595 FOR A%=1 TO 9:ITEM$(A%)="":NEXT A%
30600 COLOR TEXTFORE,TEXTBACK
30605 BOX=0:SHADOW=0:DISPTYPE=0:EDKEYS=0
30610 RETURN
30615 REM
31800 REM ********************************************************************
31805 REM -------------------- MULTIPLE SELECTION MENU -----------------------
31810 REM
31815 REM Sets up menu and selects from up to 21 items. Moves among the items
31820 REM with the arrow keys and selects item as on or off with SPACE BAR.
31825 REM Exit routine with ENTER or ESCAPE keys, and optionally PAGE UP,
31830 REM PAGE DOWN, LEFT, RIGHT, F10. Optionally draws a box around the menu.
31835 REM Item names must be in order and none may be skipped. The ROW and COL
31840 REM must allow all of menu to be displayed on the screen. Menu can be
31845 REM optionally displayed as a pull-down menu, meaning that when item is
31850 REM selected, parts of the screen that were written over are restored.
31855 REM 
31860 REM enter with ITEM$(1)="ITEM 1 message",(up to 76 chars.),ITEM$(2), etc.
31865 REM            (array must be DIMinsioned before using this routine)
31870 REM            MSG$="menu message or name", (up to 76 characters)
31875 REM            ROW, COL=upper left corner of menu
31880 REM optional - ITEMSTATUS(1)= 0 or 1, ITEMSTATUS(2)=0 or 1, etc.
31885 REM            (array must be DIMinsioned before using this routine)
31890 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK
31895 REM            FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK
31900 REM            colors optionally specified for COLOR statements
31905 REM optional - BOX=0,1,2,3 - type of outline around menu
31910 REM            0 = no box, 1 = 1 line box, 2 = 2 line box, 3 = solid box
31915 REM optional - SHADOW=0,1 - type of shadow to include with box
31920 REM            0 = no shadow, 1 = shadow
31925 REM optional - EDKEYS=0,1 - what keys allow you to exit the routine
31930 REM            0 = only ENTER or ESCAPE
31935 REM            1 = include PGUP, PGDN, LEFT and RIGHT ARROWS, F10
31940 REM optional - DISPTYPE=0,1  - type of menu/display desired
31945 REM            0 = normal menu
31950 REM            1 = pull-down menu (screen restored),
31955 REM optional - STATUSTYPE = 0,1,2 - type of selection desired
31960 REM            0 = ON or OFF, 1 = YES or NO, 2=dot to indicate selected
31965 REM exit with -ITEMSTATUS(1)-ITEMSTATUS(21)= 1 or 0, selected or not
31970 REM            ESCAPE=-1 (TRUE) if ESCAPE key hit
31975 REM            (for compatibility with old versions)
31980 REM            EXIT$=key hit that exited routine-
31985 REM            "ENTER","ESC","PGUP","PGDN","LEFT","RIGHT","F10"
31990 REM            BOX, SHADOW, DISPTYPE, STATUSTYPE, EDKEYS=0 (to maintain as optional)
31995 REM
32000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                  :REM 32000
32005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15
32010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7
32015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8
32020 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A%
32025 NUMITEMS=0:EXIT$="":ESCAPE=0
32030 ON ERROR GOTO 32050
32035 FOR A%=1 TO 21:IF ITEM$(A%)="" THEN 32055
32040 NUMITEMS=NUMITEMS+1:NEXT A%
32045 GOTO 32060
32050 RESUME 32055
32055 ON ERROR GOTO 0
32060 IF NUMITEMS+ROW+3>25 THEN ROW=25-3-NUMITEMS
32065 REM -------------- FIND MAX LNG AND PAD SHORTER ONES ---------------
32070 MAXLEN=LEN(MSG$)
32075 FOR MLOOP%=1 TO NUMITEMS
32080   IF LEN(ITEM$(MLOOP%))>MAXLEN THEN MAXLEN=LEN(ITEM$(MLOOP%))
32085 NEXT MLOOP%
32090 IF LEN(MSG$)<MAXLEN THEN MSG$=MSG$+SPACE$(MAXLEN-LEN(MSG$))
32095 FOR MLOOP%=1 TO NUMITEMS
32100   IF LEN(ITEM$(MLOOP%))<MAXLEN THEN ITEM$(MLOOP%)=ITEM$(MLOOP%)+SPACE$(MAXLEN-LEN(ITEM$(MLOOP%)))
32105 NEXT MLOOP%
32110 IF MAXLEN+COL+3>80 THEN COL=80-3-MAXLEN
32115 REM --------------- SAVE SCREEN IF PULL DOWN MENU ----------------
32120 IF DISPTYPE<>1 THEN 32190
32125 IF SHADOW<>0 THEN SHAD=2 ELSE SHAD=0
32130 DIM MSSSCHR(NUMITEMS+4+SHAD,MAXLEN+9+SHAD)
32135 DIM MSSSCOLOR(NUMITEMS+4+SHAD,MAXLEN+9+SHAD,2)
32140 R=1:C=1
32145 FOR SR%=ROW TO ROW+NUMITEMS+3+SHAD
32150   FOR SC%=COL TO COL+MAXLEN+8+SHAD
32155     MSSSCHR(R,C)=SCREEN(SR%,SC%,0)
32160     A=SCREEN(SR%,SC%,1):MSSSCOLOR(R,C,1)=(A AND 15)
32165     IF (A AND 128)=128 THEN MSSSCOLOR(R,C,1)=MSSSCOLOR(R,C,1)+16
32170     MSSSCOLOR(R,C,2)=(A AND 112)/16
32175   C=C+1:NEXT SC%
32180 R=R+1:C=1:NEXT SR%
32185 REM ---------------------- DISPLAY MENU -----------------------------
32190 LOCATE ,,0
32195 IF BOX=0 THEN TP=0:BT=0:LS=0:RS=0:MS=0:MM=0:UL=0:LL=0:UR=0:LR=0
32200 IF BOX=1 THEN TP=196:BT=196:LS=195:RS=180:MS=179:MM=196:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195
32205 IF BOX=2 THEN TP=205:BT=205:LS=204:RS=185:MS=186:MM=205:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204
32210 IF BOX=3 THEN TP=223:BT=220:LS=219:RS=219:MS=219:MM=220:UL=219:LL=219:UR=219:LR=219
32215 IROW=ROW:ICOL=COL
32220 LOCATE IROW,ICOL:COLOR TEXTFORE,TEXTBACK
32225 PRINT CHR$(UL)+STRING$(MAXLEN+7,TP)+CHR$(UR);
32230 LOCATE IROW+1,ICOL:PRINT CHR$(MS)+" ";
32235 COLOR DATAFORE,DATABACK:PRINT MSG$;
32240 COLOR TEXTFORE,TEXTBACK:PRINT "      "+CHR$(MS);
32245 LOCATE IROW+2,ICOL:COLOR TEXTFORE,TEXTBACK
32250 PRINT CHR$(LS)+STRING$(MAXLEN+7,MM)+CHR$(RS);
32255 FOR PLOOP=1 TO NUMITEMS
32260   LOCATE IROW+2+PLOOP,ICOL
32265   PRINT CHR$(MS)+" "+ITEM$(PLOOP)+"  ";
32270   SROW=PLOOP:GOSUB 32640:REM PRINT SELECT MESSAGE
32275   PRINT " "+CHR$(MS);
32280 NEXT PLOOP
32285 LOCATE IROW+3+NUMITEMS,ICOL
32290 PRINT CHR$(LL)+STRING$(MAXLEN+7,BT)+CHR$(LR);
32295 IF SHADOW=0 THEN 32395
32300 COLOR SHADOWFORE,SHADOWBACK
32305 IF BOX<>1 AND BOX<>2 THEN 32370
32310 LOCATE ROW+3+NUMITEMS,COL+2:PRINT CHR$(DN);
32315 LOCATE ROW+4+NUMITEMS,COL+2:PRINT CHR$(LL);
32320 LOCATE ROW+4+NUMITEMS,COL+3:PRINT STRING$(MAXLEN+8,CHR$(BT));
32325 LOCATE ROW+4+NUMITEMS,COL+MAXLEN+10:PRINT CHR$(LR);
32330 FOR DROW%=ROW+3+NUMITEMS TO ROW+2 STEP -1
32335   LOCATE DROW%,COL+MAXLEN+10:PRINT CHR$(MS);
32340 NEXT DROW%
32345 LOCATE ROW+1,COL+MAXLEN+8:PRINT CHR$(RT);CHR$(TP);CHR$(UR);
32350 FOR DROW%=ROW+2 TO ROW+3+NUMITEMS
32355   LOCATE DROW%,COL+MAXLEN+9:PRINT " ";
32360 NEXT DROW%
32365 GOTO 32395
32370 LOCATE ROW+4+NUMITEMS,COL+1:PRINT STRING$(MAXLEN+9,CHR$(TP));
32375 FOR DROW%=ROW+3+NUMITEMS TO ROW+1 STEP -1
32380   LOCATE DROW%,COL+MAXLEN+9:PRINT CHR$(MS);
32385 NEXT DROW%
32390 LOCATE ROW,COL+MAXLEN+9:PRINT CHR$(BT);
32395 REM
32400 REM ------------- MOVE THROUGH MENU ITEMS AND SELECT STATUS ------------
32405 IROW=1:ESCAPE=0:OLDIROW=IROW:ICOL=COL+2
32410 LOCATE OLDIROW+ROW+2,ICOL:COLOR TEXTFORE,TEXTBACK:PRINT ITEM$(OLDIROW);
32415 LOCATE OLDIROW+ROW+2,ICOL+MAXLEN+2:SROW=OLDIROW:GOSUB 32640:REM SELECT MESSAGE
32420 LOCATE IROW+ROW+2,ICOL:COLOR FIELDFORE,FIELDBACK:PRINT ITEM$(IROW);
32425 LOCATE IROW+ROW+2,ICOL+MAXLEN+2:SROW=IROW:GOSUB 32640:REM SELECT MESSAGE
32430 IN$=INKEY$:IF IN$="" THEN 32430
32435 IF IN$=CHR$(27) THEN EXIT$="ESC":ESCAPE=-1:GOTO 32550
32440 IF IN$=CHR$(13) THEN EXIT$="ENTER":GOTO 32550
32445 IF EDKEYS=0 THEN 32475
32450 IF IN$=CHR$(0)+CHR$(75) THEN EXIT$="LEFT":GOTO 32520
32455 IF IN$=CHR$(0)+CHR$(77) THEN EXIT$="RIGHT":GOTO 32520
32460 IF IN$=CHR$(0)+CHR$(73) THEN EXIT$="PGUP":GOTO 32520
32465 IF IN$=CHR$(0)+CHR$(81) THEN EXIT$="PGDN":GOTO 32520
32470 IF IN$=CHR$(0)+CHR$(68) THEN EXIT$="F10":GOTO 32520
32475 IF IN$=CHR$(0)+CHR$(72) THEN 32495:REM UP
32480 IF IN$=CHR$(0)+CHR$(80) THEN 32505:REM DOWN
32485 IF IN$=" " THEN 32520
32490 BEEP:GOTO 32430
32495 OLDIROW=IROW:IF IROW>1 THEN IROW=IROW-1:GOTO 32410
32500 IROW=NUMITEMS:GOTO 32410
32505 OLDIROW=IROW:IF IROW<NUMITEMS THEN IROW=IROW+1:GOTO 32410
32510 IROW=1:GOTO 32410
32515 REM --------------------- ITEM STATUS CHANGED ------------------------
32520 IF ITEMSTATUS(IROW)=0 THEN ITEMSTATUS(IROW)=1:GOTO 32530
32525 ITEMSTATUS(IROW)=0
32530 LOCATE IROW+ROW+2,ICOL+MAXLEN+2
32535 SROW=IROW:GOSUB 32640:REM PRINT SELECT MESSAGE
32540 GOTO 32430
32545 REM --------------- RESTORE SCREEN IF PULL DOWN MENU -----------------
32550 IF DISPTYPE<>1 THEN 32600
32555 R=1:C=1
32560 FOR SR%=ROW TO ROW+NUMITEMS+3+SHAD
32565   FOR SC%=COL TO COL+MAXLEN+8+SHAD
32570     COLOR MSSSCOLOR(R,C,1),MSSSCOLOR(R,C,2)
32575     LOCATE SR%,SC%:PRINT CHR$(MSSSCHR(R,C));
32580     C=C+1:NEXT SC%
32585   R=R+1:C=1:NEXT SR%
32590 ERASE MSSSCHR:ERASE MSSSCOLOR
32595 REM --------------------------- EXIT ---------------------------------
32600 ON ERROR GOTO 32610
32605 FOR A%=1 TO 21:ITEM$(A%)="":NEXT A%:GOTO 32620
32610 RESUME 32615
32615 ON ERROR GOTO 0
32620 COLOR TEXTFORE,TEXTBACK
32625 BOX=0:SHADOW=0:DISPTYPE=0:STATUSTYPE=0:EDKEYS=0
32630 RETURN
32635 REM -------------------- PRINT SELECT MESSAGE ------------------------
32640 IF STATUSTYPE=0 AND ITEMSTATUS(SROW)=0 THEN PRINT "OFF";
32645 IF STATUSTYPE=0 AND ITEMSTATUS(SROW)=1 THEN PRINT "ON ";
32650 IF STATUSTYPE=1 AND ITEMSTATUS(SROW)=0 THEN PRINT "NO ";
32655 IF STATUSTYPE=1 AND ITEMSTATUS(SROW)=1 THEN PRINT "YES";
32660 IF STATUSTYPE=2 AND ITEMSTATUS(SROW)=0 THEN PRINT "[ ]";
32665 IF STATUSTYPE=2 AND ITEMSTATUS(SROW)=1 THEN PRINT "["+CHR$(254)+"]";
32670 RETURN
37880 REM ********************************************************************
37885 REM ------------------------------ MENU --------------------------------
37890 REM ------- OUTLINE A WORK AREA AND PROMPT AREA AND DISPLAY A MENU -----
37895 REM ------------ SELECT FROM ITEMS ON MENU WITH F1-F10 KEYS ------------
37900 REM
37905 REM This subroutine allows you to set up a menu and select from items on
37910 REM the menu with the function keys. It sets up a "work" area and a
37915 REM "prompt" area, both which can be erased individually with their
37920 REM own respective routines. Any function key that does not have a
37925 REM message specified for it will not be allowed as a possible key to
37930 REM be hit.
37935 REM
37940 REM enter with - F1MSG$="F1 message", TO DISPLAY (UP TO 23 CHARACTERS)
37945 REM              F2MSG$,F10MSG$, etc.
37950 REM              note: unused messages must be set to null or ""
37955 REM              MSG$="program  or menu name", (up to 37 characters)
37960 REM              MENUBOX = 0,1,2,3 - type of box outline
37965 REM              0=no box, 1=1 line box, 2=2 line box, 3=solid box
37970 REM optional -   TEXTFORE,TEXTBACK,DATAFORE,DATABACK,FIELDFORE,FIELDBACK
37975 REM              colors optionally specified for COLOR statements
37980 REM exit with -  FUNCT =  1-10, depending on key hit
37985 REM              MENUBOX still set for erase prompt area routine
37990 REM              ESCAPE=-1 (TRUE) if ESCAPE key hit
37995 REM
38000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                  :REM 38000
38005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15
38010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7
38015 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A%
38020 COLOR TEXTFORE,TEXTBACK:CLS:LOCATE ,,0
38025 IF MENUBOX=0 THEN 38140
38030 IF MENUBOX=1 THEN TP=196:BT=196:SS=179:UL=218:LL=192:UR=191:LR=217
38035 IF MENUBOX=1 THEN MM=196:ML=195:MR=180:MT=194:MB=193:VT=194:VB=193
38040 IF MENUBOX=2 THEN TP=205:BT=205:SS=186:UL=201:LL=200:UR=187:LR=188
38045 IF MENUBOX=2 THEN MM=205:ML=204:MR=185:MT=203:MB=202:VT=203:VB=202
38050 IF MENUBOX=3 THEN TP=223:BT=220:SS=219:UL=219:LL=219:UR=219:LR=219
38055 IF MENUBOX=3 THEN MM=219:ML=219:MR=219:MT=223:MB=220:VT=219:VB=219
38060 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP));
38065 ROW=3:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT));
38070 ROW=19:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP));
38075 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT));
38080 COL=1:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(SS);:NEXT ROW%
38085 COL=80:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(SS);:NEXT ROW%
38090 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR);
38095 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR);
38100 LOCATE 1,19:PRINT CHR$(VT);:LOCATE 2,19:PRINT CHR$(SS);
38105 LOCATE 3,19:PRINT CHR$(VB);
38110 LOCATE 1,64:PRINT CHR$(VT);:LOCATE 2,64:PRINT CHR$(SS);
38115 LOCATE 3,64:PRINT CHR$(VB);
38120 LOCATE 3,1:PRINT CHR$(ML);:LOCATE 3,80:PRINT CHR$(MR);
38125 LOCATE 19,1:PRINT CHR$(ML);:LOCATE 19,80:PRINT CHR$(MR);
38130 COL=59:FOR ROW=20 TO 24:LOCATE ROW,COL:PRINT CHR$(SS);:NEXT
38135 LOCATE 19,59:PRINT CHR$(VT);:LOCATE 25,59:PRINT CHR$(VB);
38140 REM
38145 ROW=2:COL=42-INT((LEN(MSG$)/2)):REM display message at top
38150 COLOR DATAFORE,DATABACK:LOCATE ROW,COL
38155 PRINT MSG$;:COLOR TEXTFORE,TEXTBACK
38160 MSG$="SELECT MENU ITEM":ROW=20:COL=62:LOCATE ROW,COL:PRINT MSG$;
38165 MSG$="WITH FUNCTION KEYS ":ROW=21:COL=61:LOCATE ROW,COL:PRINT MSG$;
38170 MSG$="(F1-F10)":ROW=22:COL=66
38175 COLOR DATAFORE,DATABACK:REM set colors for DATA
38180 LOCATE ROW,COL:PRINT MSG$;
38185 COLOR TEXTFORE,TEXTBACK:REM set colors for TEXT
38190 MSG$="(ESC)ape to EXIT":ROW=24:COL=62:LOCATE ROW,COL:PRINT MSG$;
38195 MSG$="F1-"+F1MSG$:ROW=20:COL=3:LOCATE ROW,COL:PRINT MSG$;
38200 MSG$="F2-"+F2MSG$:ROW=20:COL=31:LOCATE ROW,COL:PRINT MSG$;
38205 MSG$="F3-"+F3MSG$:ROW=21:COL=3:LOCATE ROW,COL:PRINT MSG$;
38210 MSG$="F4-"+F4MSG$:ROW=21:COL=31:LOCATE ROW,COL:PRINT MSG$;
38215 MSG$="F5-"+F5MSG$:ROW=22:COL=3:LOCATE ROW,COL:PRINT MSG$;
38220 MSG$="F6-"+F6MSG$:ROW=22:COL=31:LOCATE ROW,COL:PRINT MSG$;
38225 MSG$="F7-"+F7MSG$:ROW=23:COL=3:LOCATE ROW,COL:PRINT MSG$;
38230 MSG$="F8-"+F8MSG$:ROW=23:COL=31:LOCATE ROW,COL:PRINT MSG$;
38235 MSG$="F9-"+F9MSG$:ROW=24:COL=3:LOCATE ROW,COL:PRINT MSG$;
38240 MSG$="F10-"+F10MSG$:ROW=24:COL=30:LOCATE ROW,COL:PRINT MSG$;
38245 REM
38250 COLOR DATAFORE,DATABACK:REM set colors for FIELD
38255 IF F1MSG$<>"" THEN MSG$="F1":ROW=20:COL=3:LOCATE ROW,COL:PRINT MSG$;
38260 IF F2MSG$<>"" THEN MSG$="F2":ROW=20:COL=31:LOCATE ROW,COL:PRINT MSG$;
38265 IF F3MSG$<>"" THEN MSG$="F3":ROW=21:COL=3:LOCATE ROW,COL:PRINT MSG$;
38270 IF F4MSG$<>"" THEN MSG$="F4":ROW=21:COL=31:LOCATE ROW,COL:PRINT MSG$;
38275 IF F5MSG$<>"" THEN MSG$="F5":ROW=22:COL=3:LOCATE ROW,COL:PRINT MSG$;
38280 IF F6MSG$<>"" THEN MSG$="F6":ROW=22:COL=31:LOCATE ROW,COL:PRINT MSG$;
38285 IF F7MSG$<>"" THEN MSG$="F7":ROW=23:COL=3:LOCATE ROW,COL:PRINT MSG$;
38290 IF F8MSG$<>"" THEN MSG$="F8":ROW=23:COL=31:LOCATE ROW,COL:PRINT MSG$;
38295 IF F9MSG$<>"" THEN MSG$="F9":ROW=24:COL=3:LOCATE ROW,COL:PRINT MSG$;
38300 IF F10MSG$<>"" THEN MSG$="F10":ROW=24:COL=30:LOCATE ROW,COL:PRINT MSG$;
38305 COLOR TEXTFORE,TEXTBACK:REM restore colors to TEXT
38310 REM
38315 REM ------- get a function key while displaying date and time -----
38320 REM
38325 ESCAPE=0:LOCATE ,,0
38330 IN$=INKEY$:IF IN$<>"" THEN 38345
38335 LOCATE 2,3:PRINT "DATE "+DATE$;
38340 LOCATE 2,66:PRINT "TIME "+TIME$;:GOTO 38330
38345 IF F1MSG$<>"" AND IN$=CHR$(0)+CHR$(59) THEN FUNCT=1:GOTO 38405
38350 IF F2MSG$<>"" AND IN$=CHR$(0)+CHR$(60) THEN FUNCT=2:GOTO 38405
38355 IF F3MSG$<>"" AND IN$=CHR$(0)+CHR$(61) THEN FUNCT=3:GOTO 38405
38360 IF F4MSG$<>"" AND IN$=CHR$(0)+CHR$(62) THEN FUNCT=4:GOTO 38405
38365 IF F5MSG$<>"" AND IN$=CHR$(0)+CHR$(63) THEN FUNCT=5:GOTO 38405
38370 IF F6MSG$<>"" AND IN$=CHR$(0)+CHR$(64) THEN FUNCT=6:GOTO 38405
38375 IF F7MSG$<>"" AND IN$=CHR$(0)+CHR$(65) THEN FUNCT=7:GOTO 38405
38380 IF F8MSG$<>"" AND IN$=CHR$(0)+CHR$(66) THEN FUNCT=8:GOTO 38405
38385 IF F9MSG$<>"" AND IN$=CHR$(0)+CHR$(67) THEN FUNCT=9:GOTO 38405
38390 IF F10MSG$<>"" AND IN$=CHR$(0)+CHR$(68) THEN FUNCT=10:GOTO 38405
38395 IF IN$=CHR$(27) THEN ESCAPE=-1:GOTO 38405
38400 BEEP:GOTO 38330
38405 LOCATE 2,3:PRINT "               ";
38410 LOCATE 2,66:PRINT "             ";
38415 RETURN
38420 REM
38425 REM
38465 REM ********************************************************************
38470 REM ----------------------- ERASE WORK AREA ----------------------------
38475 REM                     nothing needed on entry
38480 REM
38485 REM This subroutine allows you to erase only the "work" area
38490 REM set up in the menu subroutine.
38495 REM
38500 COLOR TEXTFORE,TEXTBACK:LOCATE ,,0                            :REM 38500
38505 FOR ROW%=4 TO 18:LOCATE ROW%,2:PRINT SPACE$(78);:NEXT ROW%
38510 RETURN
38515 REM
38565 REM ********************************************************************
38570 REM ---------------------- ERASE PROMPT AREA ---------------------------
38575 REM                     nothing needed on entry
38580 REM
38585 REM This subroutine allows you to erase only the "prompt" area
38590 REM set up in the menu subroutine.
38595 REM
38600 COLOR TEXTFORE,TEXTBACK:LOCATE ,,0                            :REM 38600
38605 FOR ROW%=20 TO 24:LOCATE ROW%,2:PRINT SPACE$(78);:NEXT ROW%
38610 IF MENUBOX=0 THEN 38630
38615 IF MENUBOX=1 THEN MT=196:MB=196
38620 IF MENUBOX=2 THEN MT=205:MB=205
38625 IF MENUBOX=3 THEN MT=223:MB=220
38630 LOCATE 19,59:PRINT CHR$(MT);:LOCATE 25,59:PRINT CHR$(MB);
38635 RETURN
38640 REM
38645 REM
49795 REM ********************************************************************
49800 REM --------------------- DISPLAY A BAR GRAPH --------------------------
49805 REM
49810 REM This subroutine displays a bar graph of up to 78 bars representing
49815 REM values from 0 to 42. The position of the bar graph can be adjusted
49820 REM by selecting where the first bar begins and by the number of spaces
49825 REM (whose length depends on the spacing between bars). Horizontal
49830 REM reference lines can be added along with scale markings for the lines.
49835 REM A vertical scale message can be centered at the left of the graph 
49840 REM and a horizontal scale message can be centered at the bottom of the
49845 REM graph area (which also determines the message's maximum length).
49850 REM
49855 REM Bar graphs that have at least one space between bars are drawn with
49860 REM the standard "TEXT" colors and those that have adjacent bars alter-
49865 REM nate between "TEXT" and "DATA" colors for easy viewing of the bars.
49870 REM
49875 REM
49880 REM
49885 REM enter with - BARVALUE(1) through BARVALUE(x), array of bar values
49890 REM              value=0 to 42 (greater than 42 will be truncated)
49895 REM              (array must be DIMinsioned before using this routine)
49900 REM              NUMBARS=number of bars to display
49905 REM              BARCOL=1 to 78, leftmost column where bars begin
49910 REM              BARSPACE=number of spaces between bars
49915 REM optional -   BARID$(1) through BARID$(x), array of identifiers
49920 REM              (array must be DIMinsioned before using this routine)
49925 REM optional -   VERTMSG$="vertical scale message", up to 23 characters
49930 REM optional -   HORIZMSG$="horizontal scale message", length adjusted
49935 REM optional -   REFLINE=0,1  0=no grid, 1=horizontal grid
49940 REM optional -   REFLINE$(1) through REFLINE$(11),
49945 REM              array of vertical scale messages used if REFLINE=1
49950 REM              (array must be DIMinsioned before using this routine)
49955 REM optional-    BOX=0,1,2,3 - type of box to draw around whole screen
49960 REM              0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid
49965 REM optional -   TEXTFORE,TEXTBACK,DATAFORE,DATABACK,FIELDFORE,FIELDBACK
49970 REM              colors optionally specified for COLOR statements
49975 REM exit with -  BOX=0, REFLINE=0 (to maintain as optional)
49980 REM
49985 REM
49990 REM
49995 REM
50000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                  :REM 50000
50005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15
50010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7
50015 COLOR TEXTFORE,TEXTBACK
50020 CLS:LOCATE ,,0
50025 IF BOX=0 THEN 50075
50030 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217
50035 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188
50040 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219
50045 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP));
50050 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT));
50055 COL=1:FOR ROW=2 TO 24:LOCATE ROW,COL:PRINT CHR$(MS);:NEXT
50060 COL=80:FOR ROW=2 TO 24:LOCATE ROW,COL:PRINT CHR$(MS);:NEXT
50065 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR);
50070 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR);
50075 BOX=0
50080 IF BARCOL=0 THEN BARCOL=3
50085 IF NUMBARS=0 THEN NUMBARS=1
50090 FIRSTCOL=BARCOL
50095 REM ----- FIND LAST COLUMN IN WHICH A BAR WILL BE DRAWN -----
50100 LASTCOL=FIRSTCOL+(NUMBARS*(BARSPACE+1))-BARSPACE-1
50105 IF LASTCOL>78 THEN LASTCOL=LASTCOL-BARSPACE-1:GOTO 50105
50110 REM
50115 REM ----- D0 VERTICAL SCALE MESSAGES AND LINES IF SELECTED -----
50120 IF REFLINE=0 THEN 50235
50125 REM ---------- PRINT MESSAGES ----------
50130 FOR BARLOOP=1 TO 11
50135   LOCATE 23-(BARLOOP*2)+1,FIRSTCOL
50140   PRINT REFLINE$(BARLOOP);
50145 NEXT BARLOOP
50150 REM ----- FIND MAXIMUM LENGTH OF SCALE MESSAGES -----
50155 MAXLEN=0
50160 FOR BARLOOP=1 TO 11
50165 L=LEN(REFLINE$(BARLOOP))
50170 IF L>MAXLEN THEN MAXLEN=L
50175 NEXT BARLOOP
50180 REM ----- ADJUST COLUMNS FOR SCALE MESSAGES -----
50185 FIRSTCOL=FIRSTCOL+MAXLEN+1:IF FIRSTCOL>78 THEN FIRSTCOL=78
50190 LASTCOL=LASTCOL+MAXLEN+1
50195 IF LASTCOL>78 THEN LASTCOL=LASTCOL-BARSPACE-1:GOTO 50195
50200 REM ---------- DRAW REFERENCE LINES ----------
50205 COLOR DATAFORE,DATABACK
50210 FOR ROW=2 TO 22
50215   LOCATE ROW,FIRSTCOL
50220   PRINT STRING$(LASTCOL-FIRSTCOL+1,95):REM underscore
50225 NEXT ROW
50230 REM ---------- DRAW BARS ----------
50235 BARCOL=FIRSTCOL
50240 FOR BARLOOP=1 TO NUMBARS
50245   BARVALUE=BARVALUE(BARLOOP)
50250   BARID$=BARID$(BARLOOP)
50255   IF BARSPACE<>0 THEN 50270
50260   IF BARLOOP MOD 2=1 THEN 50270
50265   BARFORE=DATAFORE:BARBACK=DATABACK:GOTO 50275
50270   BARFORE=TEXTFORE:BARBACK=DATABACK
50275   GOSUB 51000                                 :REM SUBROUTINE USED HERE
50280   BARCOL=BARCOL+BARSPACE+1
50285   IF BARCOL>78 THEN 50300
50290 NEXT BARLOOP
50295 REM -----
50300 COLOR DATAFORE,DATABACK
50305 REM ----- PRINT VERTICAL SCALE MESSAGE -----
50310 IF LEN(VERTMSG$)>23 THEN VERTMSG$=LEFT$(VERTMSG$,23)
50315 ROW=13-INT(LEN(VERTMSG$)/2)
50320 FOR BARLOOP=1 TO LEN(VERTMSG$)
50325   LOCATE ROW,3
50330   PRINT MID$(VERTMSG$,BARLOOP,1);
50335   ROW=ROW+1
50340 NEXT BARLOOP
50345 REM ----- PRINT HORIZONTAL SCALE MESSAGE -----
50350 BARWIDTH=LASTCOL-FIRSTCOL+1
50355 IF LEN(HORIZMSG$)>BARWIDTH THEN HORIZMSG$=LEFT$(HORIZMSG$,BARWIDTH)
50360 COL=FIRSTCOL+INT(BARWIDTH/2)-INT(LEN(HORIZMSG$)/2)-1
50365 LOCATE 24,COL:PRINT HORIZMSG$;
50370 REM -----
50375 COLOR TEXTFORE,TEXTBACK
50380 BOX=0:REFLINE=0
50385 RETURN
50390 REM
50925 REM *********************************************************************
50930 REM ---------------- DRAW 1 BAR FOR USE IN A BAR GRAPH ------------------
50935 REM
50940 REM This subroutine allows you to draw a single bar representing a
50945 REM value from 0 to 42. The base of the bar will start at the column
50950 REM of your choice and be draw upward from row 22. Row 23 will be
50955 REM where the ID is displayed, centered on the column.
50960 REM
50965 REM enter with - BARVALUE=0 to 42 (greater than 42 will be truncated)
50970 REM              BARID$="bar ID", identification at bottom of bar
50975 REM              BARCOL=column in which to draw bar
50980 REM optional -   BARFORE,BARBACK
50985 REM              colors optionally specified for COLOR statements
50990 REM
50995 REM
51000 IF BARFORE=0 AND BARBACK=0 THEN BARFORE=7                    :REM 51000
51005 COLOR BARFORE,BARBACK
51010 COL=BARCOL-INT((LEN(BARID$)-.5)/2):IF COL<1 THEN COL=1
51015 LOCATE 23,COL:PRINT BARID$;
51020 ROW=22
51025 IF BARVALUE>42 THEN BARVALUE=42
51030 IF BARCOL>80 THEN 51060
51035 FOR A=1 TO (INT(BARVALUE/2))
51040   LOCATE ROW,BARCOL:PRINT CHR$(219);
51045   ROW=ROW-1
51050 NEXT A
51055 IF (BARVALUE MOD 2)=1 THEN LOCATE ROW,BARCOL:PRINT CHR$(220);
51060 RETURN
51065 REM
59850 REM ********************************************************************
59855 REM -------------------- CREATE LARGE CHARACTERS -----------------------
59860 REM
59865 REM This routine is the first part of a 2 routine process that allows
59870 REM you create and then display messages with characters that are 4
59875 REM times the regular size. The screen can display up to 5 lines of 10
59880 REM characters each of this size. The process is divided into 2 routines
59885 REM so that messages with the large characters can be formed with the
59890 REM first routine during initialization of a program, when time is less
59895 REM of a concern, and then the messages can be displayed multiple times
59900 REM throughout the program without having to take the time to re-form
59905 REM the characters. If more than 5 large messages are needed and it is
59910 REM necessary to call this routine again, only those messages ( MSG$(1)
59915 REM to MSG$(5) ) that contain something will be formed and the others
59920 REM will be left alone. Since the process of forming large characters is
59925 REM time consuming, optional initialization messages can be displayed
59930 REM in the middle of the screen during the formation process. The screen
59935 REM is then restored after the formation process.
59940 REM
59945 REM enter with - BIGMSG$(1),BIGMSG$(2),BIGMSG$(3),BIGMSG$(4),BIGMSG$(5),
59950 REM              array of messages to create, up to 10 characters each
59955 REM              (Array must be DIMinsioned before calling this routine)
59960 REM optional  -  INITMSG=0,1  0=no messages, 1=messages
59965 REM exit with -  BIG$(1) to BIG$(20) array filled with info needed to
59970 REM              display large characters with the following routine.
59975 REM              (Array must be DIMinsioned before calling this routine)
59980 REM              BIGMSG$(1) to BIGMSG$(5) all ="" (NUL) to keep these
59985 REM              messages optional if routine is used again.
59990 REM              INITMSG=0 (to retain as optional for next time)
59995 REM
60000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                 :REM 60000
60005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15
60010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7
60015 REM ----- SAVE SCREEN WHERE INIT MESSAGES ARE DISPLAYED -----
60020 IF INITMSG=0 THEN 60070
60025 DIM BIGSSCHR(23):DIM BIGSSCOLOR(23,2)
60030 C=1:FOR COL=29 TO 51
60035   BIGSSCHR(C)=SCREEN(10,COL)
60040   A=SCREEN(10,COL,1):BIGSSCOLOR(C,1)=(A AND 15)
60045   IF (A AND 128)=128 THEN BIGSSCOLOR(C,1)=BIGSSCOLOR(C,1)+16
60050   BIGSSCOLOR(C,2)=(A AND 112)/16
60055 C=C+1:NEXT COL
60060 LOCATE 10,29,0:COLOR FIELDFORE,FIELDBACK:PRINT "   INITIALIZING ...    ";
60065 REM -------------------------------------------------------------------
60070 RESTORE 60400                   :REM POINT TO CHARACTER FONTS
60075 DIM FONT(96,8)
60080 FOR A=0 TO 95
60085   FOR B=0 TO 7
60090     READ F:FONT(A,B)=F
60095   NEXT B
60100 NEXT A
60105 REM ----- FORM CHARACTERS AND MESSAGES -----
60110 FOR MSGLOOP=1 TO 5
60115   MSG$=BIGMSG$(MSGLOOP)
60120   IF MSG$="" THEN 60235
60125   REM ---------------------------------------------
60130   IF INITMSG=0 THEN 60150
60135   LOCATE 10,29,0:COLOR FIELDFORE,FIELDBACK
60140   PRINT " FORMING MESSAGE";STR$(MSGLOOP);" ...";
60145   REM ---------------------------------------------
60150   IF LEN(MSG$)>10 THEN MSG$=LEFT$(MSG$,10)
60155   FOR CHARLOOP=1 TO LEN(MSG$)
60160      CHAR$=MID$(MSG$,CHARLOOP,1):CHARNUM=ASC(CHAR$)-32
60165      FOR BIGROW=0 TO 6 STEP 2
60170         MASK=128                       :REM (for mask=128 to 1 step /2)
60175           F=FONT(CHARNUM,BIGROW)
60180           IF (F AND MASK)=MASK THEN UPPER=-1 ELSE UPPER=0
60185           F=FONT(CHARNUM,BIGROW+1)
60190           IF (F AND MASK)=MASK THEN LOWER=-1 ELSE LOWER=0
60195           IF UPPER AND LOWER THEN PIX=219:GOTO 60215
60200           IF UPPER AND NOT LOWER THEN PIX=223:GOTO 60215
60205           IF NOT UPPER AND LOWER THEN PIX=220:GOTO 60215
60210           IF NOT UPPER AND NOT LOWER THEN PIX=32
60215           B=(BIGROW/2)+1+((MSGLOOP-1)*4):BIG$(B)=BIG$(B)+CHR$(PIX)
60220         MASK=MASK/2:IF MASK<> .5 THEN 60175      :REM (next mask) (of 8)
60225      NEXT BIGROW                                 :REM (of 4)
60230   NEXT CHARLOOP                                  :REM (of up to 10)
60235 NEXT MSGLOOP                                     :REM (of up to 5)
60240 BIGMSG$(1)="":BIGMSG$(2)="":BIGMSG$(3)="":BIGMSG$(4)="":BIGMSG$(5)=""
60245 ERASE FONT
60250 REM ----- RESTORE SCREEN -----
60255 IF INITMSG=0 THEN 60285
60260 C=1:FOR COL=29 TO 51
60265   COLOR BIGSSCOLOR(C,1),BIGSSCOLOR(C,2)
60270   LOCATE 10,COL:PRINT CHR$(BIGSSCHR(C));
60275 C=C+1:NEXT COL
60280 ERASE BIGSSCHR:ERASE BIGSSCOLOR
60285 RETURN
60290 REM
60295 REM
60300 REM
60365 REM ------------------------- CHARACTER FONTS --------------------------
60370 REM
60375 REM These are the character fonts used by the large character routine.
60380 REM They start at 32 decimal or 20 hexidecimal which is a "space" and
60385 REM go to 127 decimal or 7F hexidecimal. They include the alphanumeric
60390 REM characters, punctuation, and some other characters.
60395 REM
60400 DATA &H00,&H00,&H00,&H00,&H00,&H00,&H00,&H0
60405 DATA &H30,&H78,&H78,&H30,&H30,&H00,&H30,&H0
60410 DATA &H6C,&H6C,&H6C,&H00,&H00,&H00,&H00,&H0
60415 DATA &H6C,&H6C,&HFE,&H6C,&HFE,&H6C,&H6C,&H0
60420 DATA &H30,&H7C,&HC0,&H78,&H0C,&HF8,&H30,&H0
60425 DATA &H00,&HC6,&HCC,&H18,&H30,&H66,&HC6,&H0
60430 DATA &H38,&H6C,&H38,&H76,&HDC,&HCC,&H76,&H0
60435 DATA &H60,&H60,&HC0,&H00,&H00,&H00,&H00,&H0
60440 DATA &H18,&H30,&H60,&H60,&H60,&H30,&H18,&H0
60445 DATA &H60,&H30,&H18,&H18,&H18,&H30,&H60,&H0
60450 DATA &H00,&H66,&H3C,&HFF,&H3C,&H66,&H00,&H0
60455 DATA &H00,&H30,&H30,&HFC,&H30,&H30,&H00,&H0
60460 DATA &H00,&H00,&H00,&H00,&H00,&H30,&H30,&H60
60465 DATA &H00,&H00,&H00,&HFC,&H00,&H00,&H00,&H0
60470 DATA &H00,&H00,&H00,&H00,&H00,&H30,&H30,&H0
60475 DATA &H06,&H0C,&H18,&H30,&H60,&HC0,&H80,&H0
60480 DATA &H7C,&HC6,&HCE,&HDE,&HF6,&HE6,&H7C,&H0
60485 DATA &H30,&H70,&H30,&H30,&H30,&H30,&HFC,&H0
60490 DATA &H78,&HCC,&H0C,&H38,&H60,&HCC,&HFC,&H0
60495 DATA &H78,&HCC,&H0C,&H38,&H0C,&HCC,&H78,&H0
60500 DATA &H1C,&H3C,&H6C,&HCC,&HFE,&H0C,&H1E,&H0
60505 DATA &HFC,&HC0,&HF8,&H0C,&H0C,&HCC,&H78,&H0
60510 DATA &H38,&H60,&HC0,&HF8,&HCC,&HCC,&H78,&H0
60515 DATA &HFC,&HCC,&H0C,&H18,&H30,&H30,&H30,&H0
60520 DATA &H78,&HCC,&HCC,&H78,&HCC,&HCC,&H78,&H0
60525 DATA &H78,&HCC,&HCC,&H7C,&H0C,&H18,&H70,&H0
60530 DATA &H00,&H30,&H30,&H00,&H00,&H30,&H30,&H0
60535 DATA &H00,&H30,&H30,&H00,&H00,&H30,&H30,&H60
60540 DATA &H18,&H30,&H60,&HC0,&H60,&H30,&H18,&H0
60545 DATA &H00,&H00,&HFC,&H00,&H00,&HFC,&H00,&H0
60550 DATA &H60,&H30,&H18,&H0C,&H18,&H30,&H60,&H0
60555 DATA &H78,&HCC,&H0C,&H18,&H30,&H00,&H30,&H0
60560 DATA &H7C,&HC6,&HDE,&HDE,&HDE,&HC0,&H78,&H0
60565 DATA &H30,&H78,&HCC,&HCC,&HFC,&HCC,&HCC,&H0
60570 DATA &HFC,&H66,&H66,&H7C,&H66,&H66,&HFC,&H0
60575 DATA &H3C,&H66,&HC0,&HC0,&HC0,&H66,&H3C,&H0
60580 DATA &HF8,&H6C,&H66,&H66,&H66,&H6C,&HF8,&H0
60585 DATA &HFE,&H62,&H68,&H78,&H68,&H62,&HFE,&H0
60590 DATA &HFE,&H62,&H68,&H78,&H68,&H60,&HF0,&H0
60595 DATA &H3C,&H66,&HC0,&HC0,&HCE,&H66,&H3E,&H0
60600 DATA &HCC,&HCC,&HCC,&HFC,&HCC,&HCC,&HCC,&H0
60605 DATA &H78,&H30,&H30,&H30,&H30,&H30,&H78,&H0
60610 DATA &H1E,&H0C,&H0C,&H0C,&HCC,&HCC,&H78,&H0
60615 DATA &HE6,&H66,&H6C,&H78,&H6C,&H66,&HE6,&H0
60620 DATA &HF0,&H60,&H60,&H60,&H62,&H66,&HFE,&H0
60625 DATA &HC6,&HEE,&HFE,&HFE,&HD6,&HC6,&HC6,&H0
60630 DATA &HC6,&HE6,&HF6,&HDE,&HCE,&HC6,&HC6,&H0
60635 DATA &H38,&H6C,&HC6,&HC6,&HC6,&H6C,&H38,&H0
60640 DATA &HFC,&H66,&H66,&H7C,&H60,&H60,&HF0,&H0
60645 DATA &H78,&HCC,&HCC,&HCC,&HDC,&H78,&H1C,&H0
60650 DATA &HFC,&H66,&H66,&H7C,&H6C,&H66,&HE6,&H0
60655 DATA &H78,&HCC,&HE0,&H70,&H1C,&HCC,&H78,&H0
60660 DATA &HFC,&HB4,&H30,&H30,&H30,&H30,&H78,&H0
60665 DATA &HCC,&HCC,&HCC,&HCC,&HCC,&HCC,&HFC,&H0
60670 DATA &HCC,&HCC,&HCC,&HCC,&HCC,&H78,&H48,&H0
60675 DATA &HC6,&HC6,&HC6,&HD6,&HFE,&HEE,&HC6,&H0
60680 DATA &HC6,&HC6,&H6C,&H38,&H38,&H6C,&HC6,&H0
60685 DATA &HCC,&HCC,&HCC,&H78,&H30,&H30,&H78,&H0
60690 DATA &HFE,&HC6,&H8C,&H18,&H32,&H66,&HFE,&H0
60695 DATA &H78,&H60,&H60,&H60,&H60,&H60,&H78,&H0
60700 DATA &HC0,&H60,&H30,&H18,&H0C,&H06,&H02,&H0
60705 DATA &H78,&H18,&H18,&H18,&H18,&H18,&H78,&H0
60710 DATA &H10,&H38,&H6C,&HC6,&H00,&H00,&H00,&H0
60715 DATA &H00,&H00,&H00,&H00,&H00,&H00,&H00,&HFF
60720 DATA &H30,&H30,&H18,&H00,&H00,&H00,&H00,&H0
60725 DATA &H00,&H00,&H78,&H0C,&H7C,&HCC,&H76,&H0
60730 DATA &HE0,&H60,&H60,&H7C,&H66,&H66,&HDC,&H0
60735 DATA &H00,&H00,&H78,&HCC,&HC0,&HCC,&H78,&H0
60740 DATA &H1C,&H0C,&H0C,&H7C,&HCC,&HCC,&H76,&H0
60745 DATA &H00,&H00,&H78,&HCC,&HFC,&HC0,&H78,&H0
60750 DATA &H38,&H6C,&H60,&HF0,&H60,&H60,&HF0,&H0
60755 DATA &H00,&H00,&H76,&HCC,&HCC,&H7C,&HC,&HF8
60760 DATA &HE0,&H60,&H6C,&H76,&H66,&H66,&HE6,&H0
60765 DATA &H30,&H00,&H70,&H30,&H30,&H30,&H78,&H0
60770 DATA &H0C,&H00,&H0C,&H0C,&H0C,&HCC,&HCC,&H78
60775 DATA &HE0,&H60,&H66,&H6C,&H78,&H6C,&HE6,&H0
60780 DATA &H70,&H30,&H30,&H30,&H30,&H30,&H78,&H0
60785 DATA &H00,&H00,&HCC,&HFE,&HFE,&HD6,&HC6,&H0
60790 DATA &H00,&H00,&HF8,&HCC,&HCC,&HCC,&HCC,&H0
60795 DATA &H00,&H00,&H78,&HCC,&HCC,&HCC,&H78,&H0
60800 DATA &H00,&H00,&HDC,&H66,&H66,&H7C,&H60,&HF0
60805 DATA &H00,&H00,&H76,&HCC,&HCC,&H7C,&H0C,&H1E
60810 DATA &H00,&H00,&HDC,&H76,&H66,&H60,&HF0,&H0
60815 DATA &H00,&H00,&H7C,&HC0,&H78,&H0C,&HF8,&H0
60820 DATA &H10,&H30,&H7C,&H30,&H30,&H34,&H18,&H0
60825 DATA &H00,&H00,&HCC,&HCC,&HCC,&HCC,&H76,&H0
60830 DATA &H00,&H00,&HCC,&HCC,&HCC,&H78,&H30,&H0
60835 DATA &H00,&H00,&HC6,&HD6,&HFE,&HFE,&H6C,&H0
60840 DATA &H00,&H00,&HC6,&H6C,&H38,&H6C,&HC6,&H0
60845 DATA &H00,&H00,&HCC,&HCC,&HCC,&H7C,&H0C,&HF8
60850 DATA &H00,&H00,&HFC,&H98,&H30,&H64,&HFC,&H0
60855 DATA &H1C,&H30,&H30,&HE0,&H30,&H30,&H1C,&H0
60860 DATA &H18,&H18,&H18,&H00,&H18,&H18,&H18,&H0
60865 DATA &HE0,&H30,&H30,&H1C,&H30,&H30,&HE0,&H0
60870 DATA &H76,&HDC,&H00,&H00,&H00,&H00,&H00,&H0
60875 DATA &H00,&H10,&H38,&H6C,&HC6,&HC6,&HFE,&H0
60880 REM
60890 REM
60930 REM ********************************************************************
60935 REM -------------- DISPLAY MESSAGES WITH LARGE CHARACTERS --------------
60940 REM
60945 REM This routine is the second part of the 2 routine process that
60950 REM allows you create and then display messages with large characters.
60955 REM
60960 REM
60965 REM enter with - BIGMSG=1 to 5, which message to display 
60970 REM              ROW and COL=row and column at which to start displaying
60975 REM              the upper left corner of the message
60980 REM optional -   TEXTFORE,TEXTBACK,DATAFORE,DATABACK,FIELDFORE,FIELDBACK
60985 REM              colors optionally specified for COLOR statements
60990 REM
60995 REM
61000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7                 :REM 61000
61005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15
61010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7
61015 LOCATE ROW,COL:PRINT BIG$((BIGMSG-1)*4+1);
61020 LOCATE ROW+1,COL:PRINT BIG$((BIGMSG-1)*4+2);
61025 LOCATE ROW+2,COL:PRINT BIG$((BIGMSG-1)*4+3);
61030 LOCATE ROW+3,COL:PRINT BIG$((BIGMSG-1)*4+4);
61035 RETURN
61040 REM
61960 REM ********************************************************************
61970 REM
61975 REM This routine finds the type of video monitor hardware installed.
61980 REM It requires that the assembly language interface be installed.
61985 REM
61990 REM exit with - MONITOR$="MONO","HERC","CGA","EGA",or"VGA", monitor used
61995 REM
62000 DEF SEG=0:STATUS=PEEK(&H463):DEF SEG
62005 IF STATUS<>&HB4 THEN 62040
62010 STATUS=(INP(&H3BA) AND &H80)
62015 FOR DELAYLOOP=1 TO 30000
62020 IF (INP(&H3BA) AND &H80)<>STATUS THEN MONITOR$="HERC":RETURN
62025 NEXT DELAYLOOP
62030 MONITOR$="MONO":RETURN
62035 REM -----
62040 REGAX%=&H1A00
62045 INTERRUPT%=&H10:GOSUB 65000:REM CALL ASM
62050 IF (REGAX% AND &HFF)=&H1A THEN MONITOR$="VGA":RETURN
62055 REM -----
62060 REGAX%=&H1200:REGBX%=&H10
62065 INTERRUPT%=&H10:GOSUB 65000:REM CALL ASM
62070 IF (REGBX% AND &HFF)=&H10 THEN MONITOR$="CGA":RETURN
62075 REM -----
62080 MONITOR$="EGA":RETURN
62085 REM
62110 REM ********************************************************************
62115 REM ------------------------- MOUSE ROUTINES ---------------------------
62120 REM
62125 REM The following routines provide access to some mouse function calls.
62130 REM They require that the assembly language interface be installed.
62135 REM
62140 REM
62145 REM                
62150 REM                
62155 REM                63000   hardware reset and status
62160 REM                63100   show cursor
62165 REM                63200   hide cursor
62170 REM                63300   get button status and mouse position
62175 REM                63400   set cursor position
62180 REM                63500   get button press info
62185 REM                63600   get button release info
62190 REM                63700   set cursor limits
62195 REM                63800   set graphics cursor
62200 REM                
62205 REM                64000   set text cursor
62210 REM                64100   read motion counters
62215 REM                64200   
62220 REM                64300   
62225 REM                64400   
62230 REM                64500   
62235 REM                64600   set sensitivity and double speed
62240 REM                64700   
62245 REM                64800   
62250 REM                64900   get driver version, type, IRQ
62255 REM
62260 REM
62265 REM
62270 REM ********************************************************************
62275 REM ------------------- MOUSE - RESET AND STATUS -----------------------
62280 REM
62285 REM exit with - STATUS = -1 if mouse found and reset, otherwise 0
62290 REM             BUTTONS = number of buttons
62295 REM
63000 REGAX%=0:REGBX%=0:REGCX%=0:REGDX%=0
63005 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM
63010 STATUS=REGAX%:BUTTONS=REGBX%
63015 RETURN
63020 REM
63085 REM ********************************************************************
63090 REM ------------------- MOUSE - SHOW CURSOR ----------------------------
63095 REM
63100 REGAX%=1:INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM
63105 RETURN
63110 REM
63185 REM ********************************************************************
63190 REM ------------------- MOUSE - HIDE CURSOR ----------------------------
63195 REM
63200 REGAX%=2:INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM
63205 RETURN
63210 REM
63270 REM ********************************************************************
63275 REM ---------- MOUSE - GET CURSOR POSITION AND BUTTON STATUS -----------
63280 REM
63285 REM exit with - X and Y = cursor coordinates
63290 REM             LEFT, RIGHT, or BOTH = true for buttons pressed
63295 REM
63300 REGAX%=3
63305 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM
63310 X=REGCX%:Y=REGDX%
63315 REM -----
63320 LEFT=0:RIGHT=0:BOTH=0
63325 IF (REGBX% AND 7)=0 THEN RETURN
63330 T=TIMER
63335 IF TIMER<T+DELAY THEN 63335
63340 IF (REGBX% AND 7)=1 THEN LEFT=-1
63345 IF (REGBX% AND 7)=2 THEN RIGHT=-1
63350 IF (REGBX% AND 7)=3 THEN BOTH=-1
63355 RETURN
63360 REM
63375 REM ********************************************************************
63380 REM ------------------- MOUSE - SET CURSOR POSITION --------------------
63385 REM
63390 REM enter with - X and Y = cursor coordinates
63395 REM
63400 REGAX%=4:REGCX%=X:REGDX%=Y
63405 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM
63410 RETURN
63415 REM
63460 REM ********************************************************************
63465 REM ------------------- MOUSE - GET BUTTON PRESS INFO ------------------
63470 REM
63475 REM enter with - BUTTON = 0 (left) or 1 (right), which button to get
63480 REM exit with  - STATUS = 1 (left), 2 (right), 3 (both), current status
63485 REM              BUTTONS = number of button presses since last called
63490 REM              XPOS and YPOS = coordinates at last press
63495 REM
63500 REGAX%=5:REGBX%=BUTTON
63505 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM
63510 STATUS=REGAX%:BUTTONS=REGBX%:XPOS=REGCX%:YPOS=REGDX%
63515 RETURN
63520 REM
63560 REM ********************************************************************
63565 REM ------------------- MOUSE - GET BUTTON RELEASE INFO ----------------
63570 REM
63575 REM enter with - BUTTON = 0 (left) or 1 (right), which button to get
63580 REM exit with  - STATUS = 1 (left), 2 (right), 3 (both), current status
63585 REM              BUTTONS = number of button releases since last called
63590 REM              XPOS and YPOS = coordinates at last release
63595 REM
63600 REGAX%=6:REGBX%=BUTTON
63605 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM
63610 STATUS=REGAX%:BUTTONS=REGBX%:XPOS=REGCX%:YPOS=REGDX%
63615 RETURN
63620 REM
63670 REM ********************************************************************
63675 REM ------------------- MOUSE - SET CURSOR LIMITS ----------------------
63680 REM
63685 REM enter with - LEFTLIMIT, RIGHTLIMIT, TOPLIMIT, BOTTOMLIMIT
63690 REM              (cursor limits in X and Y coordinates)
63695 REM
63700 REGAX%=7:REGBX%=0:REGCX%=LEFTLIMIT:REGDX%=RIGHTLIMIT:REM HORIZONTAL
63705 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM
63710 REM -----
63715 REGAX%=8:REGBX%=0:REGCX%=TOPLIMIT:REGDX%=BOTTOMLIMIT:REM VERTICAL
63720 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM
63725 RETURN
63730 REM
63785 REM ********************************************************************
63790 REM ------------------- MOUSE - SET GRAPHICS CURSOR --------------------
63795 REM
63800 DIM MOUSECURSOR%(32):RESTORE 63900
63805 FOR CURSLOOP%=1 TO 32
63810   READ BINARY$
63815   BINVALUE=0:BITVALUE=1
63820   FOR CHARLOOP%=16 TO 1 STEP -1
63825     IF MID$(BINARY$,CHARLOOP%,1)="1" THEN BINVALUE=BINVALUE+BITVALUE
63830     BITVALUE=BITVALUE*2
63835   NEXT CHARLOOP%
63840   IF BINVALUE>32767 THEN BINVALUE=BINVALUE-65536!
63845   MOUSECURSOR%(CURSLOOP%)=BINVALUE
63850 NEXT CURSLOOP%
63855 REM
63860 REGAX%=9:REM SET GRAPHICS CURSOR
63865 REGBX%=8:REM HORIZONTAL HOT SPOT
63870 REGCX%=7:REM VERTICAL HOT SPOT
63875 REGDX%=VARPTR(MOUSECURSOR%(1))              :REM VERSION 6.25 AND LATER
63880 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM
63885 RETURN
63890 REM
63895 REM ----- SCREEN MASK
63900 DATA "1111111111111111"
63901 DATA "1111111000111111"
63902 DATA "1111111010111111"
63903 DATA "1111111010111111"
63904 DATA "1111111010111111"
63905 DATA "1111111010111111"
63906 DATA "1000000111000000"
63907 DATA "1011111111111110"
63908 DATA "1000000111000000"
63909 DATA "1111111010111111"
63910 DATA "1111111010111111"
63911 DATA "1111111010111111"
63912 DATA "1111111010111111"
63913 DATA "1111111000111111"
63914 DATA "1111111111111111"
63915 DATA "1111111111111111"
63916 REM ----- CURSOR MASK
63917 DATA "0000000000000000"
63918 DATA "0000000111000000"
63919 DATA "0000000101000000"
63920 DATA "0000000101000000"
63921 DATA "0000000101000000"
63922 DATA "0000000101000000"
63923 DATA "0111111000111111"
63924 DATA "0100000000000001"
63925 DATA "0111111000111111"
63926 DATA "0000000101000000"
63927 DATA "0000000101000000"
63928 DATA "0000000101000000"
63929 DATA "0000000101000000"
63930 DATA "0000000111000000"
63931 DATA "0000000000000000"
63932 DATA "0000000000000000"
63933 REM
63935 REM
63985 REM ********************************************************************
63990 REM ------------------- MOUSE - SET SOFTWARE TEXT CURSOR ---------------
63995 REM
64000 REGAX%=10:REM SET TEXT CURSOR
64005 REGBX%=0:REM SOFTWARE TEXT CURSOR
64010 REGCX%=&H77FF   :REM TRY &HFFFF
64015 REGDX%=&H7700
64020 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM
64025 RETURN
64030 REM
64035 REM
64075 REM ********************************************************************
64080 REM ------------------- MOUSE - READ MOTION COUNTERS -------------------
64085 REM
64090 REM exit with  - XMICKEY, YMICKEY, mickey counts since last called
64095 REM
64100 REGAX%=11
64105 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM
64110 XMICKEY=REGCX%:YMICKEY=REGDX%
64115 RETURN
64120 REM
64125 REM
64565 REM ********************************************************************
64570 REM ------------------- MOUSE - SET SENSITIVITY ------------------------
64575 REM
64580 REM enter with - XSENS, YSENS = 1 to 100, horiz. and vert. sensitivity
64585 REM              THRESHOLD = 0 to 100, threshold for double speed
64590 REM
64595 REM
64600 REGAX%=26:REGBX%=XSENS:REGCX%=YSENS:REGDX%=THRESHOLD
64605 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM
64610 RETURN
64615 REM
64620 REM
64865 REM ********************************************************************
64870 REM ------------------- MOUSE - GET VERSION, TYPE, IRQ -----------------
64875 REM
64880 REM exit with  - VERSION = mouse driver version number
64885 REM              MOUSETYPE = type of mouse
64890 REM              IRQ = interrupt request
64895 REM
64900 REGAX%=36
64905 INTERRUPT%=&H33:GOSUB 65000:REM CALL ASM
64910 VERSION=VAL(HEX$(INT(REGBX%/256))+"."+HEX$(REGBX% MOD 256))
64915 MOUSETYPE=INT(REGCX%/256):IRQ=REGCX% MOD 256
64920 RETURN
64925 REM
64930 REM ********************************************************************
64935 REM ----------- SET UP AND CALL ASSEMBLY LANGUAGE SUBROUTINE -----------
64940 REM
64945 REM This routine sets up and calls a previously loaded general purpose
64950 REM assembly language subroutine to access DOS and other interrupts.
64955 REM Knowledge of how to call these interrupts is required. Interrupts
64960 REM that use only registers AX,BX,CX,DX are the only ones supported.
64965 REM
64970 REM enter with - REGAX%,REGBX%,REGCX%,REGDX%
64975 REM              (registers required for calling the interrupt)
64980 REM              INTERRUPT%, the interrupt to call
64985 REM exit with -  REGAX%,REGBX%,REGCX%,REGDX%
64990 REM              (registers after returning from the interrupt)
64995 REM
65000 DEF SEG=&H4B                         :REM POINT TO SEGMENT
65005 POKE 33,INTERRUPT%                   :REM FILL IN THE INTERRUPT TO CALL
65010 POKE 4,INT(REGAX%/256):POKE 3,REGAX% MOD 256  :REM FILL IN THE REGISTERS
65015 POKE 6,INT(REGBX%/256):POKE 5,REGBX% MOD 256
65020 POKE 8,INT(REGCX%/256):POKE 7,REGCX% MOD 256
65025 POKE 10,INT(REGDX%/256):POKE 9,REGDX% MOD 256
65030 ASMSUB=0:CALL ASMSUB          :REM USE THIS LINE FOR THE INTERPRETER
65035 REM CALL ABSOLUTE(0)              :REM USE THIS LINE FOR THE COMPILER
65040 REGAX=(PEEK(4)*256)+PEEK(3):IF REGAX>32767 THEN REGAX=REGAX-65536!
65045 REGAX%=REGAX
65050 REGBX=(PEEK(6)*256)+PEEK(5):IF REGBX>32767 THEN REGBX=REGBX-65536!
65055 REGBX%=REGBX
65060 REGCX=(PEEK(8)*256)+PEEK(7):IF REGCX>32767 THEN REGCX=REGCX-65536!
65065 REGCX%=REGCX
65070 REGDX=(PEEK(10)*256)+PEEK(9):IF REGDX>32767 THEN REGDX=REGDX-65536!
65075 REGDX%=REGDX
65080 DEF SEG:RETURN                    :REM RETURN TO BASIC SEGMENT
65085 REM
65090 REM
65095 REM ********************************************************************
65100 REM ---------------- LOAD ASSEMBLY LANGUAGE SUBROUTINE -----------------
65105 REM
65110 REM This routine loads the following general purpose assembly language
65115 REM subroutine to access DOS and other interrupts. It is loaded into
65120 REM the area just below the DOS inter-program communication area.
65125 REM
65130 REM               ASSUME  CS:CODE
65135 REM               JMP     HERE
65140 REM 
65145 REM        WORKA  DW      0               ;STORAGE FOR REGISTERS-
65150 REM        WORKB  DW      0               ;BASIC WRITES THESE,
65155 REM        WORKC  DW      0               ;THEN THE INTERRUPT% HAPPENS,
65160 REM        WORKD  DW      0               ;THEN BASIC READS THESE
65165 REM
65170 REM        HERE:	MOV	AX,WORKA        ;GET PARM 1 FROM BASIC
65175 REM        	MOV	BX,WORKB        ;GET PARM 2 FROM BASIC
65180 REM        	MOV	CX,WORKC        ;GET PARM 3 FROM BASIC
65185 REM        	MOV	DX,WORKD        ;GET PARM 4 FROM BASIC
65190 REM               PUSH    DS              ;MAKE ES THE SAME AS DS
65195 REM               POP     ES
65200 REM        	INT	21H             ;DOS (or other) INTERRUPT
65205 REM        	MOV	WORKA,AX        ;SEND PARM 1 TO BASIC
65210 REM        	MOV	WORKB,BX        ;SEND PARM 2 TO BASIC
65215 REM        	MOV	WORKC,CX        ;SEND PARM 3 TO BASIC
65220 REM        	MOV	WORKD,DX        ;SEND PARM 4 TO BASIC
65225 REM               DB      0CBH            ;ASSEMBLER REJECTS "RETF"
65230 REM
65235 REM               CODE ENDS
65240 REM               END
65245 REM
65250 DEF SEG=&H4B:RESTORE 65270
65255 FOR I=0 TO 53:READ B:POKE I,B:NEXT I
65260 DEF SEG:RETURN
65265 REM -----
65270 DATA &HEB,&H09,&H90
65275 DATA &H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00       :REM REGISTERS AX-DX
65280 DATA &H2E,&HA1,&H03,&H00
65285 DATA &H2E,&H8B,&H1E,&H05,&H00
65290 DATA &H2E,&H8B,&H0E,&H07,&H00
65295 DATA &H2E,&H8B,&H16,&H09,&H00
65300 DATA &H1E,&H07
65305 DATA &HCD,&H21                                     :REM INTERRUPT% XX
65310 DATA &H2E,&HA3,&H03,&H00
65315 DATA &H2E,&H89,&H1E,&H5,&H0
65320 DATA &H2E,&H89,&H0E,&H07,&H00
65325 DATA &H2E,&H89,&H16,&H09,&H00
65330 DATA &HCB                                          :REM RETF
65335 REM
65340 REM ----------------------- END OF ROUTINES.BAS ------------------------
